home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Light ROM 1
/
LIGHT-ROM 1 (Amiga Library Services)(1994).iso
/
ffdisks
/
d938.lha
/
Angie
/
ImportedModules.lha
/
BlackMagic.mod
next >
Wrap
Text File
|
1993-10-21
|
168KB
|
4,624 lines
(* ------------------------------------------------------------------------
:Program. BlackMagic.mod
:Contents. Versatile, powerful module for GUIs, WBench Interfacing,
:Contents. Dynamic Strings, Localization, and more.
:Author. Franz Schwarz
:Copyright. Giftware (Freely distributable, yet copyrighted software.
:Copyright. If you like this magnificent;-) piece of software, you
:Copyright. are encouraged to send the author a present, a nice
:Copyright. postcard, money, or something else pleasing the author.)
:Copyright. Free use in Freely Distributable stuff (but gimme credit)
:Copyright. Explicit confirmation needed for use in commercial code
:Language. Oberon-2
:Translator. Amiga Oberon 3.00
:Support. reqtools.library V38+ -which is © by Nico François- is
:Support. needed for the 'Arguments Request' feature of ReadArgs**()
:History. BlackMagic.mod 1.0 (24.6.93) [fSchwarz] initial release
:History. 1.1 (2.7.93) [fSchwarz] added GadKey()/GadKeyA()
:History. 1.2 (6.7.93) [fSchwarz] added Max2()/Min2() and
:History. VisibleOfScreen()
:History. 1.3 (6.7.93) [fSchwarz] removed EasyRequest(Args)(),
:History. added SimpleRequest() / SimpleRequestArgs()
:History. 1.4 (9.7.93) [fSchwarz] added Dos.IoErr support
:History. for ReadArgs*(), added CmpToolNames(), ToolNameLen(),
:History. GetToolValue(), WriteTTEntry(), FLPrintf(), FLPrintF(),
:History. VFLPrintF(), Strlastn(i)cmp(), fixed minor bugs
:History. 1.5 (20.7.93) [fSchwarz] moved varargs stuff to own
:History. module BlackMagicVA, removed reqtools stuff,
:History. added ClearMem() / ClearMemAPTR()
:History. 1.6 (25.7.93) [fSchwarz] changed DynamicExtra to be
:History. variable and accessable from other modules.
:History. added external access toDynamicExtra, changed
:History. DynExpand() to use Exec.CopyMem() and copy whole
:History. array.
:History. 1.7 (27.7.93) [fSchwarz] added GetTTYScreen(), fixed
:History. BlackMagicVA <-> BlackMagic layout
:History. 1.8 (6.8.93) [fSchwarz] fixed GetTTYScreen()
:History. 1.9 (9.8.93) [fSchwarz] now really exports DynInsert()
:History. fixed bug that kept ReadArgsWBMsg(), ReadArgsWB() &
:History. ReadArgs from processing any template if none of the
:History. flags argFile / argFiles was specified. This bug kept
:History. RDArgsWB.ttRest() from beeing filled with ToolTypes
:History. on empty ("") templates passed to ReadArgsTT()
:History. 1.10 (14.8.93) [fSchwarz] introduced TRAILBLAZING
:History. 'Arguments Request' concept to ReadArgs**()
:History. with localization support, extended DynAppendTT() and
:History. WriteTTEntry().
:History. 1.11 (22.9.93) [fSchwarz] added ScrVPExtra() function
:History. 1.12 (30.9.93) [fSchwarz] adapted to OS3.0 interface
:History. modules by hartmut Goebel, changed (Un)LockWindow()
:History. 1.13 (13.10.93) [fSchwarz] fixed WriteTTEntry() bug
:History. when appending noNulTerm arrays, added DynInsertTT()
:Address. Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
:Address. uucp: Franz.Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18
:Remark. Requires OS3.0 interface modules update by hartmut Goebel
:Remark. Don't be afraid of this module's extent: OLink supports
:Remark. selective linking - so only functions that you use are
:Remark. included into your code.
:Remark. As of Amiga Oberon Release 3.00: possible odd pointers to
:Remark. array of char/byte: _don't_ compile with OddChk. The
:Remark. compiler's options stack is broken as of Amiga-Oberon 3.00
--------------------------------------------------------------------------- *)
(* $SET NODEBUG *)
MODULE BlackMagic;
(****** BlackMagic/--overview-- ***********************************************
*
* BlackMagic is a very versatile module designed for your relief
* when dealing with Graphical User Interfaces, Workbench Interfacing,
* dynamic-length strings, Localization, and more. Its Workbench argument
* parsing functions are unique in the Amiga community, yet. In fact, it
* provides you with all the flexibility and power of Dos.ReadArgs()
* argument parsing while keeping up to the Workbench ToolTypes
* design as stated in the Amiga User Interface Style Guide. It
* also takes care of project ToolTypes overriding corresponding
* tool ToolTypes entries. A trailblazing new feature that is only
* available if your system runs reqtools.library V38 or higher (which
* is © Nico François) is the 'Argument Request' feature of the
* ReadArgs**() functions, i.e. BlackMagic will pop up localized requesters
* that request either all, required or user-definable argument entries
* from the user. As an intended side effect of these functions , the parse
* functions may also be alienated from their main purpose by making
* them operate as inclusion- and/or exclusion-filters. For this
* very purpose, a new dynamic ToolType array datatype has been
* introduced for easy manipulation of the filtered ToolTypes. Similar
* to the concept of dynamic ToolType arrays, a dynamic String type has
* been introduced. As opposed to the one defined in the STRING Oberon-2
* support module supplied with the Amiga compiler, this one does not
* require a garbage collector for resource deallocation. Both, the
* dynamic ToolType array type as well as the dynamic String type are
* implemented using the new open array concept introduced in Oberon-2.
* There's another function which converts simple CLI arguments or a
* string into a ToolType array you can manipulate with this module's
* functions.
* Furthermore two functions (ReadArgs()/FreeArgs()) have been made
* available to the user, that provide a uniform interface to the Oberon
* program's arguments no matter whether the program was started from
* CLI or Workbench.
* For your ease when dealing with the Operating System, functions for
* string type conversion (LongStrPtr/Exec.STRPTR/ARRAY OF CHAR-Index
* conversion functions) as well as a general pointer arithmetics
* support functions have been supplied.
* Another field of functions, BlackMagic provides, are sprintf()-like
* functions for both, simple strings, as well as for the dynamic string
* type of this module - and all of them provide real varargs argument
* passing for the programmers ease, of course. Especially the varargs
* dynamic string sprintf()-pendant DynAppendFmt()/DSPrintf() is all you
* always missed in Amiga- Oberon, but never dared to think of in your
* wildest dreams (yeah, you'll be nuts about it, when you'll use
* DynAppendFmt()/DSPrintf() for your fist time, too;-)). After all,
* as a bonus, locale.library's FormatString() front ends (var/vector args)
* for dynamic strings are present, too - and they work without locale
* librray, too (fallback to DSPrintf()).
* Amongst BlackMagic's repertoire, there are functions for locking
* windows, setting busy pointers, functions for easy retrieval of menus
* and menu items that were created from GadTools/CreateMenusA(), and Last
* but not least, versatile and brief support functions for localization/
* catalogs with an appertaining ARexx script to convert catalog definition
* files (#?.cd) into the necessary Oberon source with string constants
* definitions.
*
* Two final notes: First, in this documentation, the term <function> is
* always used as a synonym for <procedure>.
* Finally, some implementation details: BlackMagic's Arguments parsing
* functions are implemented heavily using OOP (Object Orientated
* Programming) techniques like type-bound functions, inheritance of
* methods and dynamic binding.
*
*****************************************************************************)
(****** BlackMagic/--legal-- **************************************************
*
* LEGAL STATUS
* BlackMagic is Giftware, Copyright © 1993 by F.Schwarz. All
* Rights reserved. Giftware is an abbreviation for Freely
* Distributable Copyrighted Software (i.e. Freeware). Moreover
* the author requests a gift like a small present, money, gold,
* disks, beer, chocolate, nice postcards, or at least an email
* from people appreciating or using this software product and
* other nice boys and girls that want to please the author. You
* are encouraged to freely distribute this software for
* non-profit-making purposes, and use it in your own freely
* distributable software. However if you intend to use it in
* commercial software or shareware you may only use it under the
* condition that you consider me to be a registered, legitimate
* user of that software _and in case of commercial software_ under
* the additional condition that you ask me for explicit permission
* to include this software in your product.
*
* DISCLAIMER
* Liability - what liability?? In fact, no liability whatsoever is
* provided by the author of this software - this is generally known
* as "USE AT YOUR OWN RISK" - and that is exactly what it means.
*
* DISTRIBUTION
* This software may be distributed if only a _reasonable_ copying
* fee is charged apart from the consts for the media it is copied to.
* Furthermore, it may be included in Freely Distributable software
* libraries like AMOK, etc, including CD-ROM versions of them.
*
* Contact addresses for bug reports, comments, inquiries or anything else:
*
* Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
* email: uucp: Franz.Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18
*
*****************************************************************************)
IMPORT
e := Exec, d: Dos, I: Intuition, gt: GadTools, u: Utility, wb: Workbench,
ic: Icon, g: Graphics, loc: Locale, st: Strings, bs: BlackMagicStrings,
o: OberonLib, y: SYSTEM
(* $IF DEBUG *) , NoGuru (* $END *)
;
CONST
(* $IF DEBUG *) defaultDynamicExtra = 0;
(* $ELSE *) defaultDynamicExtra = 64; (* $END *)
VAR
DynamicExtra - : LONGINT;
TYPE
(* due to misdefinition of wb.WBArgumentsPtr: Ptr TO ARRAY 256!! OF ... *)
WBArgumentsPtr * = UNTRACED POINTER TO ARRAY MAX(LONGINT) DIV 8-1 OF wb.WBArg;
LongStrPtr * = UNTRACED POINTER TO ARRAY MAX (LONGINT)-1 OF CHAR;
LStrPtr * = LongStrPtr;
TTPtr * = UNTRACED POINTER TO ARRAY MAX (LONGINT) DIV 4-1 OF LongStrPtr;
StrVecPtr * = TTPtr;
APtrVecPtr * = UNTRACED POINTER TO ARRAY MAX (LONGINT) DIV 4-1 OF
UNTRACED POINTER TO e.APTR;
DynStrPtr * = UNTRACED POINTER TO ARRAY OF CHAR;
DynTTPtr * = UNTRACED POINTER TO ARRAY OF LongStrPtr;
(* ReadArgsWB flags *)
CONST
ignoreTool * = 0;
relPath * = 1;
dontFill * = 3;
doCD * = 4;
ignoreProject * = 5;
allowAskArg * = 6; (* also propagated to to.Init(...,flags,...) *)
askEmpty * = 7; (* also propagated to to.Init(...,flags,...) *)
askEmptyOnAlways * = 8; (* also propagated to to.Init(...,flags,...) *)
argFile * = 9; (* also propagated to to.Init(...,flags,...) *)
argFiles * = 10; (* also propagated to to.Init(...,flags,...) *)
noFullMulti * = 11; (* also propagated to to.Init(...,flags,...) *)
noMultiMulti * = 12; (* also propagated to to.Init(...,flags,...) *)
multiBarSep * = 13; (* also propagated to to.Init(...,flags,...) *)
multiCommaSep * = 14; (* also propagated to to.Init(...,flags,...) *)
disableSpecialNo * = 15; (* also propagated to to.Init(...,flags,...) *)
TemplOptFlagsMask = {allowAskArg..disableSpecialNo};
PROCEDURE^ AddPtr * (a, b: e.APTR): e.APTR;
(****** BlackMagic/DynStrLen **************************************************
*
* NAME
* DynStrLen -- Return the length of a dynamic string
*
* SYNOPSIS
* DynStrLen (dstr: DynStrPtr): LONGINT;
*
* FUNCTION
* Returns the length of the string that is currently stored
* in the dynamic, run-time allocated/expanded string array
* represented by the passed dstr handle. Note that this
* is NOT the actual current capacity of the dynamic array, i.e.
* it is not the number of characters the array can store currently.
* You may get that value by invoking the standard Oberon-2 function
* LEN (dstr^) (only with a non-NIL dstr, of course!).
* This function handles a NIL dstr handle correctly, returning null.
* (which is the one and only raison d'être for this function, by
* the way;-))
*
* INPUTS
* dstr - the dynamic string handle - may be NIL.
*
* RESULT
* The length of the string stored in the dynamic string passed as
* input parameter.
*
* SEE ALSO
* DynExpand(), DynAppend(), DStrLPtr(), InitDynStr(), ResetDynStr()
*
*****************************************************************************)
PROCEDURE DynStrLen * (dstr: DynStrPtr): LONGINT;
BEGIN
IF dstr = NIL THEN RETURN 0; END;
RETURN st.Length (dstr^);
END DynStrLen;
(****** BlackMagic/DynExpand **************************************************
*
* NAME
* DynExpand -- Ensure a specified length of a dynamic char array
*
* SYNOPSIS
* DynExpand (VAR string: DynStrPtr; len: LONGINT): BOOLEAN;
*
* FUNCTION
* Make sure that a dynamic, run-time allocated/expanded character
* array can hold at least len+1 characters while preserving its
* current contents -- performs a reallocation of the dynamic char
* array if its current length doesn't suffice. When a reallocation
* takes place, the whole contents - not only the contents until the
* first nul character- of the old dynamic char array is copied
* into the new dynamic char array. This enables usage of this
* function in conjunction with char buffers where nul is a valid
* character, generally without sacrificing performance because
* Exec.CopyMem() is usually _much_ faster than Oberon's COPY()
* command.
*
* INPUTS
* string - the dynamic char array (string) handle - may be NIL.
* len - desired minimum length. In fact, it is made sure that
* the dynamic string can store at least len+1 characters
* because of the terminating null character.
*
* RESULT
* TRUE - for success.
* FALSE - if memory allocation fails - in this case the dynamic
* char array and its handle are left unchanged.
*
* NOTES
* See DynAppend()
*
* SEE ALSO
* DynAppend(), DStrLPtr(), InitDynStr(), ResetDynStr()
*
*****************************************************************************)
PROCEDURE DynExpand * (VAR string: DynStrPtr; len: LONGINT): BOOLEAN;
VAR
str1: DynStrPtr;
BEGIN
INC (len, 1);
IF string # NIL THEN IF LEN (string^) >= len THEN RETURN TRUE; END; END;
y.ALLOCATE (str1, len+DynamicExtra); (* add some extra space for less reallocs *)
IF str1 = NIL THEN RETURN FALSE; END;
IF string # NIL THEN
e.CopyMem (string^, str1^, LEN (string^));
DISPOSE (string);
ELSE
str1^[0] := '\000';
END;
string := str1;
RETURN TRUE;
END DynExpand;
(****** BlackMagic/DynAppend **************************************************
*
* NAME
* DynAppend -- Append a string to a dynamic string
*
* SYNOPSIS
* DynAppend (VAR string: DynStrPtr; append: ARRAY OF CHAR): BOOLEAN;
*
* FUNCTION
* Appends a null-terminated char array string to a dynamic, run-
* time allocated/expanded string - performs a reallocation of the
* dynamic string if its length doesn't suffice to append the append
* string.
*
* INPUTS
* string - the dynamic string handle - may be NIL.
* append - the string to be appended - may be empty.
*
* RESULT
* TRUE - for success.
* FALSE - if memory allocation fails - in this case the dynamic
* string and its handle are left unchanged.
*
* NOTES
* Make sure that your string handle is set to NIL before its first
* reference in your code. (Amiga-Oberon does this for global
* vars, for function vars unless you set the compiler flag
* ClearVars to False, as well as for handles allocated by NEW()/
* SYSTEM.ALLOCATE()/OberonLib.Allocate() if (Exec.memClear IN
* OberonLib.MemReqs) which is the default. This is not only true for
* Dynamic String handles, but also for all other pointer vars.
* To free the dynamic string's resources, just call
* 'DISPOSE (string);'.
*
* All unfreed Dynamic Strings' resources are automatically freed
* on your program's termination.
*
* SEE ALSO
* DynInsert(), DynExpand(), DStrLPtr(), InitDynStr(), ResetDynStr()
*
*****************************************************************************)
PROCEDURE DynAppend * (VAR string: DynStrPtr; append: ARRAY OF CHAR): BOOLEAN;
(* $CopyArrays- *)
BEGIN
IF ~DynExpand (string, DynStrLen (string)+st.Length (append)+1) THEN RETURN FALSE; END;
st.Append (string^, append);
RETURN TRUE;
END DynAppend;
(****** BlackMagic/DynInsert **************************************************
*
* NAME
* DynInsert -- Insert a string in a dynamic string
*
* SYNOPSIS
* DynInsert (VAR string: DynStrPtr;
* at : LONGINT;
* ins : ARRAY OF CHAR): BOOLEAN;
*
* FUNCTION
* Inserts a null-terminated char array string in a dynamic, run-
* time allocated/expanded string at a specific position - performs
* a reallocation of the dynamic string if its length doesn't suffice
* to insert the ins string.
*
* INPUTS
* string - the dynamic string handle - may be NIL.
* at - the position (starting at 0) at which the ins string
* should be inserted in the dynamic string. Invalid
* values cause this function to return failure
* ins - the string to be inserted - may be empty.
*
* RESULT
* TRUE - for success.
* FALSE - if memory allocation fails or the specified insertion
* position was invalid. In both cases the dynamic
* string and its handle are left unchanged.
*
* NOTES
* See DynAppend()
*
* SEE ALSO
* DynAppend(), DynExpand(), DStrLPtr(), InitDynStr(), ResetDynStr()
*
*****************************************************************************)
PROCEDURE DynInsert * (VAR string: DynStrPtr;
at : LONGINT;
ins : ARRAY OF CHAR): BOOLEAN;
(* $CopyArrays- *)
BEGIN
IF (at < 0) OR (at > DynStrLen (string)) THEN RETURN FALSE; END;
IF ~DynExpand (string, DynStrLen (string)+st.Length (ins)+1) THEN RETURN FALSE; END;
st.Insert (string^, at, ins);
RETURN TRUE;
END DynInsert;
(****** BlackMagic/ResetDynStr ************************************************
*
* NAME
* ResetDynStr -- disposes a dynamic string if necessary and inits it.
*
* SYNOPSIS
* ResetDynStr (VAR dstr: DynStrPtr): BOOLEAN;
*
* FUNCTION
* Disposes the dynamic string if dstr is not NIL, and initializes it
* in a way that the dstr dynamic string handle points to a nul string.
*
* INPUTS
* string - the dynamic string handle - may be NIL.
*
* RESULT
* TRUE - for success.
* FALSE - if memory allocation fails - in this case the dynamic
* string handle is set to NIL.
*
* NOTES
* Make sure that your dstr handle is set to NIL before its first
* reference in your code. (Amiga-Oberon does this for global
* global, for function vars unless you set the compiler flag
* ClearVars to False, as well as for handles allocated by NEW()/
* SYSTEM.ALLOCATE()/OberonLib.Allocate() if (Exec.memClear IN
* OberonLib.MemReqs) which is the default. This is not only true for
* Dynamic String handles, but also for all other pointer vars.
*
* SEE ALSO
* InitDynStr(), DynExpand(), DynAppend()
*
*****************************************************************************)
PROCEDURE ResetDynStr * (VAR dstr: DynStrPtr): BOOLEAN;
BEGIN
DISPOSE (dstr);
RETURN DynAppend (dstr, "");
END ResetDynStr;
(****** BlackMagic/InitDynStr *************************************************
*
* NAME
* InitDynStr -- inits a dynamic string IGNORING its handle's value
*
* SYNOPSIS
* InitDynStr (VAR dstr: DynStrPtr): BOOLEAN;
*
* FUNCTION
* Sets the dstr handle to NIL first while ignoring its hitherto value,
* and initializes it then in a way that the dstr dynamic string handle
* points to a nul string. If you call this function for every dynamic
* string handle at the very beginning of your code, you ensure that
* you may reference all dynamic strings' contents using dstr^. Note
* however, that all functions of this module work fine with NIL-
* Dynamic String handles as well!
*
* INPUTS
* string - the dynamic string handle - may be NIL.
*
* RESULT
* TRUE - for success.
* FALSE - if memory allocation fails - in this case the dynamic
* string handle is set to NIL.
*
* SEE ALSO
* ResetDynStr(), DynExpand(), DynAppend()
*
*****************************************************************************)
PROCEDURE InitDynStr * (VAR dstr: DynStrPtr): BOOLEAN;
BEGIN
dstr := NIL;
RETURN DynAppend (dstr, "");
END InitDynStr;
(****** BlackMagic/DStrLPtr *****************************************************
*
* NAME
* DStrLPtr -- Return a 'conventional' LongStrPtr to a dynamic string
* DStrAPtr -- Return a 'conventional' Exec.APTR to a dynamic string
*
* SYNOPSIS
* DStrLPtr (dstr: DynStrPtr): LongStrPtr;
* DStrAPtr (dstr: DynStrPtr): Exec.APTR;
*
* FUNCTION
* These functions return a LongStrPtr as defined in this module, resp.
* an Exec.APTR, to the dynamic string passed as the function's
* argument. A LongStrPtr is defined as an UNTRACED POINTER TO ARRAY
* MAX(LONGINT) - 1 OF CHAR which should be in all possible cases
* used instead of Exec.STRPTR, if you don't know the array
* bound of the string. This keeps you from ugly runtime errors
* you get when you manipulate Exec.STRPTR^ beyond the 256th char
* element. (Exec.STRPTR is currently definded as ARRAY 256 OF CHAR)
* Note however, that you have to use (* [Dollar]CopyArrays- *) for
* your functions that have ARRAY OF CHAR parameters, you may pass
* LongStrPtr^ to.
*
* INPUTS
* dstr - the dynamic string handle - may be NIL.
*
* RESULT
* a LongStrPtr / Exec.APTR pointing to the first char element of the
* dstr or NIL if dstr is NIL.
*
* SEE ALSO
* DynAppend(), StrIndex()
*
*****************************************************************************)
PROCEDURE DStrLPtr * (dstr: DynStrPtr): LongStrPtr;
BEGIN
IF dstr = NIL THEN RETURN NIL; END;
RETURN y.ADR (dstr^[0]);
END DStrLPtr;
PROCEDURE DStrAPtr * (dstr: DynStrPtr): e.APTR;
BEGIN
RETURN DStrLPtr (dstr);
END DStrAPtr;
(****** BlackMagic/StrIndex ****************************************************
*
* NAME
* StrIndex -- Return a LongStrPtr to a string index.
* StrIndexA -- Return an Exec.APTR to a string index.
*
* SYNOPSIS
* StrIndex (str: ARRAY OF CHAR; n: LONGINT): LongStrPtr;
* StrIndexA (str: ARRAY OF CHAR; n: LONGINT): Exec.APTR;
*
* FUNCTION
* These functions return a LongStrPtr as defined in this module,
* resp. an Exec.APTR, pointing to the nth element of the string str.
* This function is extremely useful since there are thousands if
* not millions of occasions where you need to pass an array of char
* starting with a specific index of another string to a function,
* especially when working with the Operating System.
* Note however, that you have to use (* [Dollar]CopyArrays- *) for
* your functions that have ARRAY OF CHAR parameters, you may pass
* LongStrPtr^ to.
*
* INPUTS
* str - the string to operate on
* n - the ordinal index - may be even negative since no range
* checking takes place
*
* RESULT
* a LongStrPtr / Exec.APTR pointing to the nth char of the string.
*
* SEE ALSO
* DStrLPtr()
*
*****************************************************************************)
PROCEDURE StrIndex * (str: ARRAY OF CHAR; n: LONGINT): LongStrPtr;
(* $CopyArrays- *)
BEGIN
RETURN AddPtr (y.ADR (str[0]), n);
END StrIndex;
PROCEDURE StrIndexA * (str: ARRAY OF CHAR; n: LONGINT): e.APTR;
(* $CopyArrays- *)
BEGIN
RETURN StrIndex (str, n);
END StrIndexA;
(****** BlackMagic/StrToLStr ************************************************
*
* NAME
* StrToLStr - Typecast an Exec.STRPTR into a LongStrPtr
*
* SYNOPSIS
* StrToLStr (str: Exec.STRPTR): LongStrPtr;
*
* FUNCTION
* This function simply typecasts the str Exec.STRPTR passed into
* a LongStrPtr which may be needed when dealing with Operating System
* structures and functions whose STRPTR typed strings you want to
* manipulate without disabling the compiler's range checking.
*
* INPUTS
* str - the Exec.STRPTR which is to be typecasted - may be NIL.
*
* RESULT
* the LongStrPtr
*
* NOTES
* you should be able to pass an Exec.APTR to this function
*
* SEE ALSO
* LStrToStr(), DStrLPtr(), StrIndex()
*
*****************************************************************************)
PROCEDURE StrToLStr * (str: e.STRPTR): LongStrPtr;
BEGIN
RETURN AddPtr (str, 0);
END StrToLStr;
(****** BlackMagic/LStrToStr ************************************************
*
* NAME
* LStrToStr - Typecast a LongStrPtr into an Exec.STRPTR;
*
* SYNOPSIS
* LStrToStr (lstr: LongStrPtr): Exec.STRPTR;
*
* FUNCTION
* This function simply typecasts the lstr LongStrPtr passed into
* an Exec.STRPTR which may be needed when dealing with Operating
* System structures and functions that expect Exec.STRPTRs.
*
* INPUTS
* lstr - the LongStrPtr that is to be typecasted - may be NIL.
*
* RESULT
* the Exec.STRPTR
*
* NOTES
* you should be able to pass an Exec.APTR to this function
*
* SEE ALSO
* StrToLStr(), DStrLPtr(), StrIndex()
*
*****************************************************************************)
PROCEDURE LStrToStr * (lstr: LongStrPtr): e.STRPTR;
BEGIN
RETURN AddPtr (lstr, 0);
END LStrToStr;
(****** BlackMagic/DynTTLen **************************************************
*
* NAME
* DynTTLen -- Return the length of a dynamic ToolType array
*
* SYNOPSIS
* DynStrLen (tt: DynTTPtr): LONGINT;
*
* FUNCTION
* Returns the number of entries that are currently stored
* in the dynamic, run-time allocated/expanded ToolType array
* represented by the passed tt handle. Note that this
* is NOT the actual current capacity of the dynamic array, i.e.
* it is not the number of ToolTypes the array can store currently.
* You may get that value by invoking the standard Oberon-2 function
* LEN (dstr^) (only with a non-NIL tt, of course!).
* This function handles a NIL tt handle correctly, returning null.
*
* INPUTS
* tt - the dynamic ToolType array handle - may be NIL.
*
* RESULT
* The number of entries that are currently stored in the dynamic
* ToolType array passed as input parameter.
*
* SEE ALSO
* DynAppendTT(), DynInsertTT(), WriteTTEntry()
*
*****************************************************************************)
PROCEDURE DynTTLen * (tt: DynTTPtr): LONGINT;
VAR
i: LONGINT;
BEGIN
IF tt = NIL THEN RETURN 0; END;
i := 0;
WHILE tt[i] # NIL DO INC (i); END;
RETURN i;
END DynTTLen;
(* DynAppendTT flags *)
CONST
createEmpty * = 0; (* create empty TT handle if NIL, otherwise NOP, ignore chr array *)
noNulTerm * = 1; (* copy the whole structure / array, don't stop on Nul *)
(****** BlackMagic/DynAppendTT *************************************************
*
* NAME
* DynAppendTT -- Append a string to a dynamic ToolType array.
*
* SYNOPSIS
* DynAppendTT (VAR tt : DynTTPtr;
* append : ARRAY OF SYSTEM.BYTE;
* flags : SET ): BOOLEAN;
*
* FUNCTION
* This function adds a string / structure / array to a
* dynamically, run-time allocated, NIL-terminated array of
* pointers to null-terminated strings. Space for the string /
* structure / array is allocated.
* A dynamic ToolType array handle (DynTTPtr) is defined as an
* UNTRACED POINTER TO ARRAY OF LongStrPtr. If the array size is
* insufficient, this function reallocates it.
*
* INPUTS
* tt - the dynamic ToolType array handle - may be NIL.
* append - the string / structure / array to be appended
* flags - currently two flags are defined:
* createEmpty: If you specify it, <append> is ignored,
* and this function just returns TRUE except when the
* ToolType array handle is NIL - in that case it will
* allocate a minimal ToolType array and write NIL into
* its first element, indicating that the array contains
* no elements.
* noNulTerm indicates that <append> should be treated as
* a fixed size structure / array rather than as a string,
* i.e. the whole <append> is copied, not only until the
* first Nul character.
*
* RESULT
* TRUE - for success.
* FALSE - if memory allocation failed - in this case the contents
* of the ToolType array - NOT necessarily the handle
* itself - is left unchanged.
*
* NOTES
* You should initialize the ToolType array handle with
* 'tt := MIL;' before your first call to DynAppendTT().
*
* It is of utmost importance that you only specify the flag(s)
* documented along with this function for the flags argument since
* otherwise unexpected things may happen to the system, to the
* computer, and finally to yourself (you may get a nervous, violent
* fit of temper, run amok, or even commit suicide due to your machine
* crashing at the very moment when you want to save save your hitherto
* unsaved source for your new great, nifty, revolutionary,
* trailblazing, unprecedented new software project!)) - Just kidding,
* girls & boys, currently no severe things may result, but this may
* well change in the future!
*
* SEE ALSO
* FreeDynTT(), WriteTTEntry(), RemDynTTEntry(), DynInsertTT(),
* TTAPtr()
*
*****************************************************************************)
PROCEDURE DynAppendTT * (VAR tt : DynTTPtr;
append : ARRAY OF y.BYTE;
flags : SET ): BOOLEAN;
VAR
tt1 : DynTTPtr;
origlen, i : LONGINT;
ls : LongStrPtr;
(* $CopyArrays- *)
BEGIN
origlen := DynTTLen (tt);
ls := y.ADR (append);
IF tt # NIL THEN
IF createEmpty IN flags THEN RETURN TRUE; END;
END;
LOOP
IF tt # NIL THEN IF LEN (tt^) >= origlen+2 THEN EXIT; END; END;
y.ALLOCATE (tt1, origlen+2+DynamicExtra DIV 4); (* add some extra space for less reallocs *)
IF tt1 = NIL THEN RETURN FALSE; END;
IF tt # NIL THEN
FOR i:=0 TO origlen DO tt1^[i] := tt^[i]; END;
DISPOSE (tt);
END;
tt := tt1;
EXIT;
END;
tt [origlen+1] := NIL;
IF createEmpty IN flags THEN
tt [origlen] := NIL;
ELSE
IF noNulTerm IN flags THEN
o.Allocate (tt [origlen], LEN (append));
ELSE
o.Allocate (tt [origlen], st.Length (ls^)+1);
END;
IF tt [origlen] = NIL THEN RETURN FALSE; END;
IF noNulTerm IN flags THEN
e.CopyMem (append, tt [origlen]^, LEN (append));
ELSE
COPY (ls^, tt [origlen]^);
END;
END;
RETURN TRUE;
END DynAppendTT;
(****** BlackMagic/WriteTTEntry ***********************************************
*
* NAME
* WriteTTEntry -- Write a TTEntry into a dynamic ToolType array.
*
* SYNOPSIS
* WriteTTEntry (VAR dtt: DynTTPtr;
* Entry : LONGINT;
* str : ARRAY OF SYSTEM.BYTE;
* flags : SET ): BOOLEAN;
*
* FUNCTION
* This function writes a string / structure / array at a
* specific position to a dynamically, run-time
* allocated, NIL-terminated array of pointers to nul-
* terminated strings / non-nul-terminated structures or
* arrays. Space for the string / structure / array is
* allocated. A potential old string / structure / array is
* deleted first. A dynamic ToolType array handle (DynTTPtr)
* is defined as an UNTRACED POINTER TO ARRAY OF LongStrPtr.
* If the array size is insufficient, this function reallocates
* it.
*
* INPUTS
* dtt - the ToolType array handle - may be NIL.
* Entry - The ordinal number of the entry where the string
* is to be written, starting at zero, or -1 to
* append at the end of the ToolType array.
* str - the string / structure / array to add
* flags - noNulTerm indicates that <str> should be treated as
* a fixed size structure / array rather than as a
* string, i.e. the whole <str> is copied, not only
* until the first Nul character.
* No other flags are defined currently.
*
* RESULT
* TRUE - for success.
* FALSE - if memory allocation failed - in this case the contents
* of the ToolType array - NOT necessarily the handle
* itself - is left unchanged.
*
* SEE ALSO
* DynAppendTT(), RemDynTTEntry(), FreeDynTT(), DynInsertTT(),
* TTAPtr()
*
*****************************************************************************)
PROCEDURE WriteTTEntry * (VAR dtt: DynTTPtr;
Entry : LONGINT;
str : ARRAY OF y.BYTE;
flags : SET ): BOOLEAN;
VAR
i : LONGINT;
ls : LongStrPtr;
str1: LongStrPtr;
(* $CopyArrays- *)
BEGIN
str1 := y.ADR (str[0]);
ls := NIL;
i := DynTTLen (dtt);
IF (Entry < -1) OR (Entry > i) THEN RETURN FALSE; END;
IF (Entry = -1) OR (Entry = i) THEN
RETURN DynAppendTT (dtt, str, flags)
END;
IF dtt = NIL THEN RETURN FALSE; END;
IF noNulTerm IN flags THEN
o.Allocate (ls, LEN (str));
ELSE
o.Allocate (ls, st.Length (str1^)+1);
END;
IF ls = NIL THEN RETURN FALSE; END;
IF noNulTerm IN flags THEN
e.CopyMem (str, ls^, LEN (str));
ELSE
COPY (str1^, ls^);
END;
DISPOSE (dtt[Entry]); dtt[Entry] := ls;
RETURN TRUE;
END WriteTTEntry;
(****** BlackMagic/DynInsertTT ************************************************
*
* NAME
* DynInsertTT -- Insert a TTEntry into a dynamic ToolType array.
*
* SYNOPSIS
* DynInsertTT (VAR dtt: DynTTPtr;
* Entry : LONGINT;
* str : ARRAY OF SYSTEM.BYTE;
* flags : SET ): BOOLEAN;
*
* FUNCTION
* This function inserts a string / structure / array at a
* pecific position (starting at 0) to a dynamically, run-time
* allocated, NIL-terminated array of pointers to nul-
* terminated strings / non-nul-terminated structures or
* arrays. Space for the string / structure / array is
* allocated. A dynamic ToolType array handle (DynTTPtr)
* is defined as an UNTRACED POINTER TO ARRAY OF LongStrPtr.
*
* INPUTS
* dtt - the ToolType array handle - may be NIL.
* Entry - The ordinal number of the entry, at which the
* stringis to be written, starting at zero. Invalid
* values causes this function to return failure.
* str - the string / structure / array to add
* flags - noNulTerm indicates that <str> should be treated as
* a fixed size structure / array rather than as a
* string, i.e. the whole <str> is copied, not only
* until the first Nul character.
* No other flags are defined currently.
*
* RESULT
* TRUE - for success.
* FALSE - if memory allocation failed or the Entry value was
* invalid - in this case the contents
* of the ToolType array - NOT necessarily the handle
* itself - is left unchanged.
*
* SEE ALSO
* DynAppendTT(), RemDynTTEntry(), WriteTTEntry(), FreeDynTT(),
* TTAPtr()
*
*****************************************************************************)
PROCEDURE DynInsertTT * (VAR dtt: DynTTPtr;
Entry : LONGINT;
str : ARRAY OF y.BYTE;
flags : SET ): BOOLEAN;
VAR
i,j : LONGINT;
ls : LongStrPtr;
(* $CopyArrays- *)
BEGIN
ls := NIL;
i := DynTTLen (dtt);
IF (Entry < 0) OR (Entry > i) THEN RETURN FALSE; END;
IF ~DynAppendTT (dtt, str, flags) THEN RETURN FALSE; END;
ls := dtt[i];
FOR j := i-1 TO Entry BY -1 DO dtt[j+1] := dtt[j]; END;
dtt[Entry] := ls;
RETURN TRUE;
END DynInsertTT;
(****** BlackMagic/FreeDynTT ***************************************************
*
* NAME
* FreeDynTT -- Frees a ToolType array handle's resources & resets it.
*
* SYNOPSIS
* FreeDynTT (VAR dtt: DynTTPtr);
*
* FUNCTION
* This function frees all resources that may have been allocated
* for a ToolType array and reinitializes its handle to NIL.
* It is save to invoke this function with a NIL ToolType array
* handle.
*
* INPUTS
* dtt - the ToolType array handle - may be NIL.
*
* NOTES
* All unfreed ToolType arrays' resources are automatically freed
* on your program's termination.
*
* SEE ALSO
* AppendDynTT(), RemDynTTEntry(), TTAPtr()
*
*****************************************************************************)
PROCEDURE FreeDynTT * (VAR dtt: DynTTPtr);
VAR
i: LONGINT;
BEGIN
IF dtt = NIL THEN RETURN; END;
i := 0;
LOOP
IF i>=LEN (dtt^) THEN EXIT; END;
IF dtt^[i] = NIL THEN EXIT; END;
DISPOSE (dtt^[i]);
INC (i);
END;
DISPOSE (dtt);
END FreeDynTT;
(****** BlackMagic/RemDynTTEntry ***********************************************
*
* NAME
* RemDynTTEntry -- Remove an entry from a dynamic ToolType array.
*
* SYNOPSIS
* RemDynTTEntry (dtt: DynTTPtr; Entry: LONGINT): BOOLEAN;
*
* FUNCTION
* This function removes an entry from a dynamic ToolType array.
* Removes the 'Entrieth' entry (count starts at 0) or the last
* entry if Entry is -1, and deallocates the space for it.
* This function is safe to call with insensible parameters like
* NIL ToolType array handles, empty ToolType arrays, or invalid Entry
* values. In these cases, it will return FALSE, otherwise TRUE.
*
* INPUTS
* dtt - the ToolType array handle - may be NIL.
* Entry - The ordinal number of the entry to be removed, starting
* at zero, or -1 to remove the last entry.
*
* RESULT
* TRUE - for success.
* FALSE - for 'insensible' parameters
*
* SEE ALSO
* DynAppendTT(), FreeDynTT(), TTAPtr()
*
*****************************************************************************)
PROCEDURE RemDynTTEntry * (dtt: DynTTPtr; Entry: LONGINT): BOOLEAN;
VAR
i,j: LONGINT;
BEGIN
IF dtt = NIL THEN RETURN FALSE; END;
i := DynTTLen (dtt);
DEC (i);
IF Entry = -1 THEN Entry := i; END;
IF (Entry < 0) OR (Entry > i) THEN RETURN FALSE; END;
DISPOSE (dtt[Entry]);
FOR j := Entry TO i DO dtt[j] := dtt[j+1]; END;
RETURN TRUE;
END RemDynTTEntry;
(****** BlackMagic/TTAPtr ******************************************************
*
* NAME
* TTAptr -- Returns a conventional pointer to a dynamic ToolType array
*
* SYNOPSIS
* TTAPtr (dtt: DynTTPtr): TTPtr;
*
* FUNCTION
* This function returns a TTPtr as defined in this module
* to the dynamic ToolType array passed as the function's argument.
* A TTPtr is defined as an UNTRACED POINTER TO ARRAY MAX(LONGINT)
* DIV 4 - 1 OF LongStrPtr. It is especially useful to pass it to
* or to convert function results frm other functions that deal with
* ToolTypes such as the icon.library's, etc.
* Since this module's ReadArgs() functions return structure
* RDArgsWB contain two dynamic ToolType array handles, which you may
* use or manipulate with all of this module's documented dynamic
* ToolType array handle related functions, you may convert
* them to conventional ToolType array handles using this function.
*
* INPUTS
* dtt - the dynamic ToolType array handle - may be NIL.
*
* RESULT
* The respective 'conventional' TTPtr equivalent.
*
* SEE ALSO
* DynAppendTT(), FreeDynTT(), RemDynTTEntry()
*
*****************************************************************************)
PROCEDURE TTAPtr * (dtt: DynTTPtr): TTPtr;
BEGIN
IF dtt = NIL THEN RETURN NIL; END;
RETURN y.ADR (dtt^[0]);
END TTAPtr;
CONST
(* type modifiers for template options *)
ignoreC = 'I';
strC = '\x00';
numC = 'N';
switchC = 'S';
toggleC = 'T';
multiNumC= '\x00';
remainC = 'F';
multiC = 'M';
(* attribute modifiers for template options *)
keyC = 'K';
alwaysC = 'A';
(* type values *)
ignore = 0;
str = 1;
num = 2;
switch = 3;
toggle = 4;
multiNum= 5;
remain = 6;
multi = 7;
maxType = multi; (* highest type value *)
AddEmptyName = maxType+1;
(* attribute set elements for TemplOpt.flags, etc *)
keyAttr = 0;
alwaysAttr = 1;
numAttr = 2;
(* flag for TemplOpt.flags *)
requestArg = 4;
TYPE
TmplTypArrT = ARRAY maxType+1 OF CHAR;
CONST
tmplTypes = TmplTypArrT ('I\000NST\000FM');
tmplTypesSansNum = TmplTypArrT ('I\000\000ST\000FM'); (* required for special /M/N handling *)
TYPE
TemplOptPtr = UNTRACED POINTER TO TemplOpt;
TemplOpt = RECORD
name : DynStrPtr;
names : DynTTPtr;
activeName : LongStrPtr;
flags : SET;
pri : LONGINT; (* was: type: LONGINT; *)
used : BOOLEAN;
entry : UNTRACED POINTER TO e.APTR;
entryBackUp: e.APTR;
END;
TemplIgnore = RECORD (TemplOpt)
END;
TemplStrT = RECORD (TemplOpt)
string: DynStrPtr;
END;
TemplStr = RECORD (TemplStrT)
END;
TemplRemain = RECORD (TemplStrT)
END;
TemplSwitchT = RECORD (TemplOpt)
END;
TemplSwitch = RECORD (TemplSwitchT)
END;
TemplToggle = RECORD (TemplSwitchT)
END;
TemplNum = RECORD (TemplOpt)
num: LONGINT;
END;
TemplMultiT = RECORD (TemplOpt)
argsArr: DynTTPtr;
END;
TemplMulti = RECORD (TemplMultiT)
END;
TemplMultiNum = RECORD (TemplMultiT)
END;
TemplArrT = UNTRACED POINTER TO ARRAY OF TemplOptPtr;
RDArgsPtr * = UNTRACED POINTER TO RDArgs;
RDArgs * = RECORD
END;
RDArgsWBPtr * = UNTRACED POINTER TO RDArgsWB;
RDArgsWB * = RECORD (RDArgs)
opts : TemplArrT;
oldCD : d.FileLockPtr; (* NIL is a valid oldCD directory! *)
validCD : BOOLEAN; (* thus this entry... *)
ttIncl * : DynTTPtr;
ttRest * : DynTTPtr;
END;
RDArgsCLIPtr * = UNTRACED POINTER TO RDArgsCLI;
RDArgsCLI = RECORD (RDArgs)
rda: d.RDArgsPtr;
END;
PROCEDURE^ FreeTemplArr (Arr: TemplArrT);
PROCEDURE (VAR rda: RDArgs) Free();
BEGIN
END Free;
PROCEDURE (VAR rda: RDArgsWB) Free();
BEGIN
IF rda.opts = NIL THEN RETURN; END;
IF rda.validCD THEN y.SETREG (0, d.CurrentDir (rda.oldCD)); END;
FreeTemplArr (rda.opts);
FreeDynTT (rda.ttRest);
FreeDynTT (rda.ttIncl);
END Free;
PROCEDURE (VAR rda: RDArgsCLI) Free();
BEGIN
IF rda.rda = NIL THEN RETURN; END;
d.FreeArgs (rda.rda); rda.rda := NIL;
END Free;
(****** BlackMagic/ToolNameLen ************************************************
*
* NAME
* ToolNameLen -- Get length of ToolType's name from a tt argument str
*
* SYNOPSIS
* ToolNameLen (tt: ARRAY OF CHAR): LONGINT;
*
* FUNCTION
* Returns the length of the name part of a ToolType arguemnt
* string. This is done by checking for the first occurence of
* either nul or '='.
*
* INPUTS
* tt - the ToolType argument string
*
* RESULT
* the length of the ToolType's name part.
*
* SEE ALSO
* GetToolValue(), ToolNameLen()
*
*****************************************************************************)
PROCEDURE ToolNameLen * (tt: ARRAY OF CHAR): LONGINT;
VAR
ii: LONGINT;
(* $CopyArrays- *)
BEGIN
ii := 0;
WHILE (tt[ii] # '=') & (tt[ii] # '\000') DO INC (ii); END;
RETURN ii;
END ToolNameLen;
PROCEDURE (VAR to: TemplOpt) ToolNameLen (tt: ARRAY OF CHAR): LONGINT;
(* $CopyArrays- *)
BEGIN
IF to.activeName # NIL THEN IF to.activeName^ = "" THEN RETURN 0; END; END;
RETURN ToolNameLen (tt);
END ToolNameLen;
(****** BlackMagic/CmpToolNames ************************************************
*
* NAME
* CmpToolNames -- test two ToolTypes's names for equality
*
* SYNOPSIS
* CmpToolNames (tt1, tt2: ARRAY OF CHAR): BOOLEAN;
*
* FUNCTION
* Compares two ToolTypes' names
*
* INPUTS
* tt1,tt2 - the ToolType argument strings
*
* RESULT
* TRUE if the ToolTypes' names are identical (case insensitive),
* FALSE otherwise.
*
* SEE ALSO
* ToolNameLen(), GetToolValue()
*
*****************************************************************************)
PROCEDURE CmpToolNames * (tt1, tt2: ARRAY OF CHAR): BOOLEAN;
(* $CopyArrays- *)
BEGIN
IF ToolNameLen (tt1) = ToolNameLen (tt2) THEN
IF u.Strnicmp (tt1, tt2, ToolNameLen (tt1)) = 0 THEN
RETURN TRUE;
END;
END;
RETURN FALSE;
END CmpToolNames;
(****** BlackMagic/GetToolValue ***********************************************
*
* NAME
* GetToolValue -- Return LongStrPtr to value part of tt argument str
*
* SYNOPSIS
* GetToolValue (tt: ARRAY OF CHAR): LongStrPtr;
*
* FUNCTION
* Returns a LongStrPtr to the value part of the provided ToolType
* argument string. This is done by getting the length of the name
* part with ToolNameLen(), and returning either a pointer
* to the next character, or if the next character is '=' a pointer
* to the character right after the next charcter.
*
* INPUTS
* tt - the ToolType argument string
*
* RESULT
* the LongStrPtr to the value part of the ToolType
*
* SEE ALSO
* ToolNameLen(), CmpToolNames()
*
*****************************************************************************)
PROCEDURE GetToolValue * (tt: ARRAY OF CHAR): LongStrPtr;
VAR
l: LONGINT;
(* $CopyArrays- *)
BEGIN
l := ToolNameLen (tt); IF tt[l] = '=' THEN INC (l); END;
RETURN StrIndex (tt, l);
END GetToolValue;
PROCEDURE (VAR to: TemplOpt) GetToolValue (tt: ARRAY OF CHAR): LongStrPtr;
(* $CopyArrays- *)
BEGIN
IF to.activeName # NIL THEN IF to.activeName^ = "" THEN
RETURN StrIndex (tt, 0);
END; END;
RETURN GetToolValue (tt);
END GetToolValue;
CONST
solelyMakeUnused = 0; (* flag for TemplOpt.Free() *)
PROCEDURE (VAR to: TemplOpt) Free (flags: SET);
BEGIN
IF to.used THEN
to.used := FALSE;
to.entry^ := to.entryBackUp;
END;
IF ~(solelyMakeUnused IN flags) THEN
DISPOSE (to.name);
FreeDynTT (to.names);
END;
END Free;
PROCEDURE (VAR ts: TemplStrT) Free (flags: SET);
BEGIN
ts.Free^ (flags);
DISPOSE (ts.string);
END Free;
PROCEDURE (VAR tm: TemplMultiT) Free (flags: SET);
BEGIN
tm.Free^ (flags);
FreeDynTT (tm.argsArr);
END Free;
PROCEDURE (VAR to: TemplOpt) Init (Name : ARRAY OF CHAR;
VAR Res : y.BYTE;
flags : SET;
VAR TotNames: DynTTPtr ): BOOLEAN;
VAR
s : DynStrPtr;
i,j,k: LONGINT;
ls : LongStrPtr;
PROCEDURE CleanUp (success: BOOLEAN): BOOLEAN;
BEGIN
DISPOSE (s);
IF ~success THEN
FreeDynTT (to.names);
DISPOSE (to.name);
END;
RETURN success;
END CleanUp;
(* $CopyArrays- *)
BEGIN
s := NIL; to.name := NIL; to.names := NIL; to.activeName := NIL;
to.flags := flags; to.used := FALSE;
to.entry := y.ADR (Res); to.entryBackUp := to.entry^;
IF ~DynAppend (to.name, Name) THEN RETURN CleanUp (FALSE); END;
IF ~DynAppend (s, Name) THEN RETURN CleanUp (FALSE); END;
s[0] := CHR (0);
j := 0; i := 0;
LOOP
IF (Name[i] = '=') OR (Name[i] = CHR (0)) THEN
st.Cut (Name, j, i-j, s^);
k := 0;
WHILE TotNames[k] # NIL DO
IF (u.Stricmp (s^, TotNames[k]^) = 0) &
~(to IS TemplIgnore) THEN RETURN CleanUp (FALSE); END;
INC (k);
END;
IF s^ = "" THEN
IF (to.pri > maxType) OR
(keyAttr IN to.flags) THEN RETURN CleanUp (FALSE); END;
END;
IF ~DynAppendTT (to.names, s^, {}) THEN RETURN CleanUp (FALSE); END;
IF ~(to IS TemplIgnore) THEN
IF ~DynAppendTT (TotNames, s^, {}) THEN RETURN CleanUp (FALSE); END;
IF s^ = "" THEN to.pri := to.pri + AddEmptyName; END;
END;
j := i+1;
END;
IF Name[i] = CHR (0) THEN EXIT; END;
INC (i);
END;
IF to.pri > maxType THEN (* move empty name to the end of array *)
i := 0;
WHILE to.names[i] # NIL DO
IF to.names[i]^ = "" THEN j := i; END;
INC (i);
END;
DEC (i);
ls := to.names[i]; to.names[i] := to.names[j]; to.names[j] := ls;
END;
RETURN CleanUp (TRUE);
END Init;
PROCEDURE (VAR ts: TemplStrT) Init (Name : ARRAY OF CHAR;
VAR Res : y.BYTE;
flags : SET;
VAR TotNames: DynTTPtr ): BOOLEAN;
(* $CopyArrays- *)
BEGIN
ts.string := NIL;
RETURN ts.Init^ (Name, Res, flags, TotNames);
END Init;
PROCEDURE (VAR ts: TemplStr) Init (Name : ARRAY OF CHAR;
VAR Res : y.BYTE;
flags : SET;
VAR TotNames: DynTTPtr ): BOOLEAN;
(* $CopyArrays- *)
BEGIN
ts.pri := str;
RETURN ts.Init^ (Name, Res, flags, TotNames);
END Init;
PROCEDURE (VAR ts: TemplSwitch) Init (Name : ARRAY OF CHAR;
VAR Res : y.BYTE;
flags : SET;
VAR TotNames: DynTTPtr ): BOOLEAN;
(* $CopyArrays- *)
BEGIN
ts.pri := switch;
IF ~ts.Init^ (Name, Res, flags, TotNames) THEN RETURN FALSE; END;
IF ts.pri > maxType THEN ts.Free({}); RETURN FALSE; END; (* no empty name please *)
RETURN TRUE;
END Init;
PROCEDURE (VAR tn: TemplNum) Init (Name : ARRAY OF CHAR;
VAR Res : y.BYTE;
flags : SET;
VAR TotNames : DynTTPtr ): BOOLEAN;
(* $CopyArrays- *)
BEGIN
tn.pri := num;
RETURN tn.Init^ (Name, Res, flags, TotNames);
END Init;
PROCEDURE (VAR ti: TemplIgnore) Init (Name : ARRAY OF CHAR;
VAR Res : y.BYTE;
flags : SET;
VAR TotNames : DynTTPtr ): BOOLEAN;
(* $CopyArrays- *)
BEGIN
ti.pri := ignore; flags := {};
RETURN ti.Init^ (Name, Res, flags, TotNames);
END Init;
PROCEDURE (VAR tg: TemplToggle) Init (Name : ARRAY OF CHAR;
VAR Res : y.BYTE;
flags : SET;
VAR TotNames: DynTTPtr ): BOOLEAN;
(* $CopyArrays- *)
BEGIN
tg.pri := toggle;
IF ~tg.Init^ (Name, Res, flags, TotNames) THEN RETURN FALSE; END;
IF tg.pri > maxType THEN tg.Free({}); RETURN FALSE; END; (* no empty name please *)
RETURN TRUE;
END Init;
PROCEDURE (VAR tr: TemplRemain) Init (Name : ARRAY OF CHAR;
VAR Res : y.BYTE;
flags : SET;
VAR TotNames: DynTTPtr ): BOOLEAN;
(* $CopyArrays- *)
BEGIN
tr.pri := remain;
RETURN tr.Init^ (Name, Res, flags, TotNames);
END Init;
PROCEDURE (VAR tm: TemplMultiT) Init (Name : ARRAY OF CHAR;
VAR Res : y.BYTE;
flags : SET;
VAR TotNames: DynTTPtr ): BOOLEAN;
(* $CopyArrays- *)
BEGIN
tm.argsArr := NIL;
RETURN tm.Init^ (Name, Res, flags, TotNames);
END Init;
PROCEDURE (VAR tm: TemplMulti) Init (Name : ARRAY OF CHAR;
VAR Res : y.BYTE;
flags : SET;
VAR TotNames: DynTTPtr ): BOOLEAN;
(* $CopyArrays- *)
BEGIN
tm.pri := multi;
RETURN tm.Init^ (Name, Res, flags, TotNames);
END Init;
PROCEDURE (VAR tm: TemplMultiNum) Init (Name : ARRAY OF CHAR;
VAR Res : y.BYTE;
flags : SET;
VAR TotNames: DynTTPtr ): BOOLEAN;
(* $CopyArrays- *)
BEGIN
tm.pri := multiNum;
RETURN tm.Init^ (Name, Res, flags, TotNames);
END Init;
PROCEDURE DisposeTemplOpt (VAR to: TemplOptPtr);
BEGIN
IF to = NIL THEN RETURN END;
to.Free ({});
to := NIL;
END DisposeTemplOpt;
(* CmpTT flags *)
CONST
specialNo = 0;
PROCEDURE CmpTT (s : DynTTPtr; tt: ARRAY OF CHAR; flags: SET): LongStrPtr;
VAR
i : LONGINT;
ls : LongStrPtr;
(* $CopyArrays- *)
BEGIN
IF s = NIL THEN RETURN NIL; END;
FOR i := 0 TO LEN (s^)-1 DO
IF s[i] = NIL THEN RETURN NIL; END;
IF specialNo IN flags THEN
IF u.Strnicmp ("NO", s[i]^, 2) = 0 THEN
ls := y.ADR (s[i] [2]);
IF (u.Strnicmp (ls^, tt, st.Length (ls^)) = 0) &
(ToolNameLen (tt) = st.Length (ls^)) THEN RETURN s[i]; END;
END;
IF u.Strnicmp ("NO", tt, 2) = 0 THEN
ls := y.ADR (tt[2]);
IF (u.Strnicmp (s[i]^, ls^, st.Length (s[i]^)) = 0) &
(ToolNameLen (ls^) = st.Length (s[i]^)) THEN RETURN s[i]; END;
END;
ELSE
IF (s[i]^ = "") OR
((u.Strnicmp (s[i]^, tt, ToolNameLen (tt)) = 0) &
(st.Length (s[i]^) = ToolNameLen (tt))) THEN RETURN s[i]; END;
END;
END; (* FOR *)
RETURN NIL;
END CmpTT;
(* to.Process return codes *)
CONST
fail = 0;
ok = 1;
okSwitchT = 2;
okSpecNo = 3;
(* to.Cmp return codes *)
CONST
notFound = 0;
found = 1;
foundEmpty = 2;
foundNoSpc = 3;
foundSwitchT = 4;
PROCEDURE (VAR to: TemplOpt) Cmp (tt : ARRAY OF CHAR;
status: LONGINT ): LONGINT;
(* $CopyArrays- *)
BEGIN
IF status # fail THEN RETURN notFound; END;
to.activeName := CmpTT (to.names, tt, {});
IF to.activeName = NIL THEN
RETURN notFound;
ELSIF to.activeName^ = "" THEN
RETURN foundEmpty;
ELSE
RETURN found;
END;
END Cmp;
PROCEDURE (VAR ti: TemplIgnore) Cmp (tt : ARRAY OF CHAR;
status: LONGINT ): LONGINT;
VAR
(* $CopyArrays- *)
BEGIN
RETURN notFound;
END Cmp;
PROCEDURE (VAR ts: TemplSwitchT) Cmp (tt : ARRAY OF CHAR;
status: LONGINT ): LONGINT;
VAR
s : LongStrPtr;
(* $CopyArrays- *)
BEGIN
IF status # okSwitchT THEN
IF ts.Cmp^ (tt, fail) = found THEN RETURN foundSwitchT; END; (* foundEmpty impossible for TemplSwitchT! *)
END;
IF (status = okSpecNo) OR (disableSpecialNo IN ts.flags) THEN RETURN notFound; END;
ts.activeName := CmpTT (ts.names, tt, {specialNo});
IF ts.activeName = NIL THEN RETURN notFound; END;
s := ts.GetToolValue (tt);
IF (s^ = "") OR ic.MatchToolValue (s^, "FALSE") OR
ic.MatchToolValue (s^, "NO") OR ic.MatchToolValue (s^, "TRUE") OR
ic.MatchToolValue (s^, "YES") THEN
RETURN foundNoSpc;
END;
RETURN notFound;
END Cmp;
PROCEDURE (VAR to: TemplOpt) Process (tt: ARRAY OF CHAR): LONGINT;
(* $CopyArrays- *)
BEGIN
RETURN fail;
END Process;
PROCEDURE (VAR ts: TemplStr) Process (tt: ARRAY OF CHAR): LONGINT;
(* $CopyArrays- *)
BEGIN
IF ts.used THEN RETURN fail; END;
IF ~DynAppend (ts.string, ts.GetToolValue (tt)^) THEN RETURN fail; END;
ts.entry^ := DStrLPtr (ts.string);
ts.used := TRUE;
RETURN ok;
END Process;
PROCEDURE (VAR tr: TemplRemain) Process (tt: ARRAY OF CHAR): LONGINT;
(* $CopyArrays- *)
BEGIN
IF tr.used & (noFullMulti IN tr.flags) THEN RETURN fail; END;
IF tr.string # NIL THEN
IF ~DynAppend (tr.string, " ") THEN RETURN fail; END;
END;
IF ~DynAppend (tr.string, tr.GetToolValue (tt)^) THEN RETURN fail; END;
tr.entry^ := DStrLPtr (tr.string);
tr.used := TRUE;
RETURN ok;
END Process;
PROCEDURE (VAR ts: TemplSwitch) Process (tt: ARRAY OF CHAR): LONGINT;
VAR
val : LONGINT;
specialno: BOOLEAN;
(* $CopyArrays- *)
BEGIN
IF ts.used THEN RETURN fail; END;
specialno := CmpTT (ts.names, tt, {}) = NIL;
val := I.LTRUE;
LOOP
IF ts.GetToolValue (tt)^ = "" THEN EXIT END;
IF ic.MatchToolValue (ts.GetToolValue (tt)^, "TRUE") OR
ic.MatchToolValue (ts.GetToolValue (tt)^, "YES") THEN
IF ic.MatchToolValue (ts.GetToolValue (tt)^, "FALSE") OR
ic.MatchToolValue (ts.GetToolValue (tt)^, "NO") THEN RETURN fail; END;
EXIT;
END;
IF ~ic.MatchToolValue (ts.GetToolValue (tt)^, "FALSE") &
~ic.MatchToolValue (ts.GetToolValue (tt)^, "NO") THEN RETURN fail; END;
val := I.LFALSE;
EXIT;
END;
IF specialno THEN
IF val = I.LTRUE THEN val := I.LFALSE; ELSE val := I.LTRUE; END;
END;
ts.entry^ := val;
ts.used := TRUE;
IF specialno THEN RETURN okSpecNo; ELSE RETURN okSwitchT; END;
END Process;
PROCEDURE (VAR tg: TemplToggle) Process (tt: ARRAY OF CHAR): LONGINT;
VAR
val : LONGINT;
specialno : BOOLEAN;
(* $CopyArrays- *)
BEGIN
IF tg.used THEN RETURN fail; END;
specialno := CmpTT (tg.names, tt, {}) = NIL;
val := I.LTRUE;
LOOP
IF tg.GetToolValue (tt)^ = "" THEN
IF ~specialno THEN
IF tg.entry^ = 0 THEN val := I.LTRUE; ELSE val := I.LFALSE; END;
END;
EXIT;
END;
IF ic.MatchToolValue (tg.GetToolValue (tt)^, "TRUE") OR
ic.MatchToolValue (tg.GetToolValue (tt)^, "YES") THEN
IF ic.MatchToolValue (tg.GetToolValue (tt)^, "FALSE") OR
ic.MatchToolValue (tg.GetToolValue (tt)^, "NO") THEN RETURN fail; END;
EXIT;
END;
IF ~ic.MatchToolValue (tg.GetToolValue (tt)^, "FALSE") &
~ic.MatchToolValue (tg.GetToolValue (tt)^, "NO") THEN RETURN fail; END;
val := I.LFALSE;
EXIT;
END;
IF specialno THEN
IF val = I.LTRUE THEN val := I.LFALSE; ELSE val := I.LTRUE; END;
END;
tg.entry^ := val;
tg.used := TRUE;
IF specialno THEN RETURN okSpecNo; ELSE RETURN okSwitchT; END;
END Process;
(****** BlackMagic/StrToLong ************************************************
*
* NAME
* StrToLong - convert (hexa)decimal string to integer representation
*
* SYNOPSIS
* StrToLong (str: ARRAY OF CHAR; VAR result: LONGINT): BOOLEAN;
*
* FUNCTION
* StrToLong converts a (hexa)decimal string representatation of an
* integer into an integer. Leading white space chars are skipped,
* then a sign char ('+','-') may occur, followed by decimal digits
* or a '0x', '0X' or '[Dollar]' hex identifier followed by hex digits.
* After the digits sequence, any number of white space chars may
* terminate the string.
*
* INPUTS
* str - the string holding the number
* result - the variable that will hold the resulting integer
* if a valid number is read.
*
* RESULT
* TRUE if a number was successfully read into the result variable,
* false otherwise
* FALSE if an error occurred. In that case the result variable holds
* the generated number at the very stage when the error occurred.
*
****************************************************************************)
PROCEDURE StrToLong * (str: ARRAY OF CHAR; VAR result: LONGINT): BOOLEAN;
VAR
i: LONGINT;
c: INTEGER;
neg: BOOLEAN;
hex: BOOLEAN;
base: INTEGER;
(* $CopyArrays- $OvflChk- *)
BEGIN
result := 0; i := 0; neg := FALSE; hex := FALSE;
WHILE (str[i] = ' ') OR (str[i] = '\t') DO INC (i); END;
CASE str[i] OF
'+': INC (i); |
'-': neg := TRUE; INC (i);
ELSE END;
CASE str[i] OF
'$': hex := TRUE; INC (i); |
'0': IF CAP(str[i+1])='X' THEN hex := TRUE; INC (i,2); END;
ELSE END;
IF ~hex THEN base := 10; ELSE base := 16; END;
LOOP
c := ORD (CAP (str[i]));
CASE c OF
ORD('0')..ORD('9'):
c := c - ORD ('0'); |
ORD('A')..ORD('F'):
IF ~hex THEN y.SETREG (0, d.SetIoErr (d.badNumber)); RETURN FALSE; END;
c := c - ORD ('A') + 10;
ELSE
LOOP
CASE str[i] OF
CHR (0) : IF neg THEN result := - result; END; RETURN TRUE; |
' ', '\t': INC (i); |
ELSE y.SETREG (0, d.SetIoErr (d.badNumber)); RETURN FALSE; END;
END;
END;
result := base * result + c;
INC (i);
END;
END StrToLong;
(* $OvflChk= *)
PROCEDURE (VAR tn: TemplNum) Process (tt: ARRAY OF CHAR): LONGINT;
(* $CopyArrays- *)
BEGIN
IF tn.used THEN RETURN fail; END;
IF ~StrToLong (tn.GetToolValue (tt)^, tn.num) THEN RETURN fail; END;
tn.entry^ := y.ADR (tn.num);
tn.used := TRUE;
RETURN ok;
END Process;
PROCEDURE (VAR tm: TemplMultiT) Process (tt: ARRAY OF CHAR): LONGINT;
VAR
ds : DynStrPtr;
s1 : LongStrPtr;
c1,c2,i : LONGINT;
num : LONGINT;
PROCEDURE CleanUp();
BEGIN
DISPOSE (ds);
WHILE i>0 DO IF RemDynTTEntry (tm.argsArr, -1) THEN END; DEC (i); END;
END CleanUp;
PROCEDURE ArgFil (): BOOLEAN;
BEGIN
RETURN (((u.Stricmp (tm.activeName^, "FILE")=0) & (argFile IN tm.flags)) OR
((u.Stricmp (tm.activeName^, "FILES")=0) & (argFiles IN tm.flags)) ) &
~(requestArg IN tm.flags)
END ArgFil;
(* $CopyArrays- *)
BEGIN
ds := NIL; i := 0; c1 := 0; c2 := 0; s1 := NIL;
IF tm.used & (noMultiMulti IN tm.flags) & ~ArgFil() THEN CleanUp(); RETURN fail; END;
s1 := tm.GetToolValue (tt);
IF ~DynAppend (ds, s1^) THEN CleanUp(); RETURN fail; END;
ds[0] := CHR (0);
LOOP
IF ((((s1[c2] = ',') & (multiCommaSep IN tm.flags)) OR
((s1[c2] = '|') & (multiBarSep IN tm.flags))) & ~ArgFil()) OR
(s1[c2] = CHR (0)) THEN
st.Cut (s1^, c1, c2-c1, ds^);
WITH tm: TemplMultiNum DO
IF ~StrToLong (ds^, num) THEN CleanUp(); RETURN fail; END;
IF ~DynAppendTT (tm.argsArr, num, {noNulTerm}) THEN CleanUp(); RETURN fail; END; |
tm: TemplMulti DO
IF ~DynAppendTT (tm.argsArr, ds^, {}) THEN CleanUp(); RETURN fail; END;
END;
INC (i);
IF s1[c2] = CHR (0) THEN EXIT; END;
c1 := c2+1;
END;
INC (c2);
END; (* LOOP *)
i := 0;
tm.entry^ := TTAPtr (tm.argsArr);
CleanUp();
tm.used := TRUE;
RETURN ok;
END Process;
PROCEDURE (VAR to: TemplOpt) EntryToTT (): DynStrPtr;
BEGIN
RETURN NIL;
END EntryToTT;
PROCEDURE (VAR ts: TemplStrT) EntryToTT (): DynStrPtr;
VAR
ls: LStrPtr;
ds: DynStrPtr;
BEGIN
IF ~InitDynStr (ds) THEN RETURN NIL; END;
ls := ts.entry^;
IF ls # NIL THEN
IF ~DynAppend (ds, ls^) THEN DISPOSE (ds); END;
END;
RETURN ds;
END EntryToTT;
PROCEDURE (VAR ts: TemplSwitchT) EntryToTT (): DynStrPtr;
VAR
ds: DynStrPtr;
BEGIN
ds := NIL;
IF ~DynAppend (ds, "FALSE") THEN RETURN NIL; END;
IF ts.entry^ # NIL THEN COPY ("TRUE", ds^); END;
RETURN ds;
END EntryToTT;
PROCEDURE^ VDSPrintf * (VAR dstr: DynStrPtr;
format : ARRAY OF CHAR;
args : e.APTR ): BOOLEAN;
PROCEDURE^ VDynFmtLocale * (VAR dstr: DynStrPtr;
locale : loc.LocalePtr;
format : ARRAY OF CHAR;
args : e.APTR ): BOOLEAN;
PROCEDURE (VAR tn: TemplNum) EntryToTT (): DynStrPtr;
VAR
ds: DynStrPtr;
BEGIN
IF ~InitDynStr (ds) THEN RETURN NIL; END;
IF tn.entry^ # NIL THEN
IF ~VDSPrintf (ds, "%ld", tn.entry^) THEN DISPOSE (ds); END;
END;
RETURN ds;
END EntryToTT;
CONST
numFmt = "%ld%lc";
strFmt = "%s%lc";
PROCEDURE^ Max2 * (x, y: LONGINT): LONGINT;
PROCEDURE (VAR tm: TemplMultiT) EntryToTT (): DynStrPtr;
VAR
ds: DynStrPtr;
ls: LStrPtr;
ar: APtrVecPtr;
i : LONGINT;
pa: ARRAY 2 OF e.APTR;
BEGIN
IF ~InitDynStr (ds) THEN RETURN NIL; END;
IF tm.flags * {multiCommaSep,multiBarSep} = {} THEN
WITH tm: TemplMultiNum DO
INCL (tm.flags, multiCommaSep); |
tm: TemplMulti DO
INCL (tm.flags, multiBarSep);
END;
END;
ar := tm.entry^;
IF ar # NIL THEN
WITH tm: TemplMultiNum DO
ls := StrIndex (numFmt, 0); |
tm: TemplMulti DO
ls := StrIndex (strFmt, 0);
END;
IF multiCommaSep IN tm.flags THEN pa[1] := ORD (','); ELSE pa[1] := ORD ('|'); END;
i := 0;
WHILE ar[i] # NIL DO
WITH tm: TemplMultiNum DO
pa[0] := ar[i]^; |
tm: TemplMulti DO
pa[0] := ar[i];
END;
IF ~VDSPrintf (ds, ls^, y.ADR (pa[0])) THEN DISPOSE (ds); RETURN NIL; END;
INC (i);
END; (* WHILE *)
ds [Max2 (0, st.Length(ds^)-1)] := '\000';
END; (* IF ar # NIL *)
RETURN ds;
END EntryToTT;
PROCEDURE^ GetCatalogStr * (catalog: loc.CatalogPtr;
string : ARRAY OF CHAR ): LongStrPtr;
PROCEDURE (VAR to: TemplOpt) ReqPrompt (): DynStrPtr;
VAR
ds: DynStrPtr;
typeStr, opt: LStrPtr;
a : ARRAY 3 OF e.APTR;
(* $CopyArrays- *)
BEGIN
ds := NIL; typeStr := NIL; opt := NIL;
WITH to: TemplStr DO
typeStr := StrIndex (bs.itemString, 0); opt := StrIndex ("", 0); |
to: TemplRemain DO
typeStr := StrIndex (bs.itemString, 0); opt := StrIndex ("/R", 0); |
to: TemplSwitch DO
typeStr := StrIndex (bs.itemBool, 0); opt := StrIndex ("/S", 0); |
to: TemplToggle DO
typeStr := StrIndex (bs.itemBool, 0); opt := StrIndex ("/T", 0); |
to: TemplNum DO
typeStr := StrIndex (bs.itemInteger, 0); opt := StrIndex ("/N", 0); |
to: TemplMulti DO
IF multiCommaSep IN to.flags THEN
typeStr := StrIndex (bs.itemStringsCommaSep, 0);
ELSE
typeStr := StrIndex (bs.itemStringsBarSep, 0);
END;
opt := StrIndex ("/M", 0); |
to: TemplMultiNum DO
IF multiCommaSep IN to.flags THEN
typeStr := StrIndex (bs.itemIntegersCommaSep, 0);
ELSE
typeStr := StrIndex (bs.itemIntegersBarSep, 0);
END;
opt := StrIndex ("/M/N", 0);
END;
a[0] := GetCatalogStr (bs.DefaultCatalog, typeStr^);
a[1] := StrIndex (to.name^, 0);
a[2] := opt;
IF ~VDynFmtLocale (ds, NIL, GetCatalogStr (bs.DefaultCatalog,
bs.fmtRequestArgPrompt)^,
y.ADR (a[0])) THEN DISPOSE (ds); END;
RETURN ds;
END ReqPrompt;
PROCEDURE FreeTemplArr (Arr: TemplArrT);
VAR
i: LONGINT;
BEGIN
IF Arr = NIL THEN RETURN; END;
FOR i := 0 TO LEN (Arr^)-1 DO
IF Arr[i] # NIL THEN
Arr[i].Free({});
DISPOSE (Arr[i]);
END;
END;
DISPOSE (Arr);
END FreeTemplArr;
CONST
askMagic = "ASK:";
PROCEDURE (VAR to: TemplOpt) SkipAskMagic (tt : ARRAY OF CHAR;
found : LONGINT ): LStrPtr;
VAR
i: LONGINT;
(* $CopyArrays- *)
BEGIN
IF (found # foundEmpty) & (allowAskArg IN to.flags) &
(u.Strnicmp (tt, askMagic, 4) = 0) THEN i := 4; ELSE i := 0; END;
RETURN StrIndex (tt, i);
END SkipAskMagic;
(* ReqTools V38 definitions: *)
VAR
req: e.LibraryPtr;
PROCEDURE rtGetString {req, -72} (VAR buffer{9}: ARRAY OF CHAR;
maxchars{0}: LONGINT;
title{10}: ARRAY OF CHAR;
reqInfo{11}: e.APTR;
tag1{8}..: u.Tag): BOOLEAN;
CONST
rtTagBase = u.user;
gsFlags = rtTagBase+22;
gsTextFmt = rtTagBase+38;
gsTextFmtArgs= rtTagBase+39;
gsAllowEmpty = rtTagBase+80;
gsReqCenterText = 2;
(****** BlackMagic/ReadArgsTT *************************************************
*
* NAME
* ReadArgsTT -- Parse ToolType's input similar to Dos.ReadArgs()
*
* SYNOPSIS
* ReadArgsTT (tmpl : ARRAY OF CHAR;
* args : ARRAY OF y.BYTE;
* ttTool, ttProject: TTPtr;
* flags : SET ): RDArgsWBPtr;
*
* FUNCTION
* This function is a very versatile and powerful ToolTypes parse
* routine, supplying you with all the flexibility of current
* Dos.ReadArgs, plus access to the ToolTypes that weren't used
* to fill the argument fields, as well as to the ones used.
* This function is also well-suited for filtering ToolTypes,
* manipulating the ToolTypes of one or more DiskObjects, merging
* ToolTypes of two DiskObjects into one ToolType array, etc.
* The aim of this function was also to follow the Amiga User Style
* Guide's claim that the project's ToolTypes should be merged with
* the tool's ToolTypes, while the project's ToolTypes supercede the
* tool's ones, etc. This function may be controlled using several
* flags, resulting in thorough-going configurability of its behaviour
* in fields like handling of /M,/F,/T & /S options. Furthermore this
* function is quite fool-proof to a certain extent, and accepts only
* sensible command line templates. Starting with Version 1.10,
* missing, required or user-definable template entries may be requested
* through string requesters if reqtools.library V38 or higher (which is
* © Nico François) is installed in the system running your software.
* The requester itself is localized and pops with an equivalent string
* of the current contents of the appertaining argument array.
*
* INPUTS
* tmpl - A command line template as defined in the the
* documentation of Dos.ReadArgs() For a complete
* description, look there. Full support for aliases/
* abbreviations ("Quit=Q/S" or "Multi=/S" etc.)
* is available.
*
* Possible types of template options:
*
* no specifier - string
* The action of this option template is to fill
* the arguemnt entry with the string value of the
* first matching ToolType.
*
* /N - number
* The argument entry is filled with a pointer to
* an integer, or left unchanged if not provided
* In addidtion to decimal numbers, hexadecimal numbers
* are accepted if they are preceded by a [Dollar] or '0x'
* If no valid number is provided, the entry is left
* unchanged.
*
* /S - switch -- implies option modifier /K
* The argument entry is filled with -1 (LTRUE) if
* the keyword is specified as a ToolType with no
* value or values YES or TRUE. It is filled with
* 0 (LFALSE) if the ToolType has NO or FALSE as its
* value. There is also, if you don't supply the flag
* disableSpecialNo, a more extentsive recognition:
* If the template option and a tooltype name
* match each other except a missing prefix 'NO' of one of
* them, after
* checking all other options' non-empty names for exact
* equality (as oppposed to 'NO'-prefix equality), the
* ToolType is considered to fit for that /S option:
* If the ToolType has no value, or it's value is YES or
* TRUE, the arguemnt entry will be filled with a 0 (LFALSE)
* If it's value is FALSE or NO, the entry will be filled
* with -1 (LTRUE). Note that in any case, if the ToolType
* value is not empty, TRUE, YES, FALSE or NO, no action will
* take place, and in the case of 'NO'-prefix equality the
* ToolType won't be considered to appertain to this option.
*
* /T - toggle -- implies option modifier /K
* The action for this option type exactly follows the
* description of the /S (switch) option except that
* in the case of exact equality (not 'NO'-prefix equality)
* if the ToolType has no value assigned, the action will
* toggle the arguemnt entry: if it is 0 (LFALSE),
* it will turn into -1 (LTRUE), otherwise it will turn into
* LFALSE.
*
* /M - Multi
* The argument entry is filled with a pointer to a NIL-
* terminated array of pointers to strings.
* The action for this option type is heavily influenced
* by the following flags:
* noMultiMulti:The first matching ToolType is considered
* only - all later matches will be ignored. Useful in
* connection with the other flags:
* multiBarSep: Considers the ToolType value string to
* consist of several differnt strings, seperated
* by vertical bars (|)
* multiCommaSep: Same goes for this - yet the separators
* are commas (,) in this case.
*
* /M/N - MultiNum
* The action for this is the same as for /M (Multi) type,
* except that the tooltype values must be numbers, and
* the argument entry is filled with a pointer to an array
* of pointers to LONGINTs (32 bit integers) For more
* information also look at the /N (number) option type.
* Note that if there are one or more invalid numbers
* in a ToolType value, and multi****Sep is enabled,
* no number of that ToolType will be regarded to be valid.
*
* /F - Full remainder
* All matching ToolType values will be joined, with one
* whitespace separator between them, and the argument
* entry will be filled with a pointer to that string.
* This type is affected by the noFullMulti flag. If it is
* specified, only the first matching ToolType will match,
* all other following matching ToolTypes are ignored, i.e.
* the action is the same as with simple String option type.
*
* /I - Ignore
* Yes, you,re right!;-) This is just a dummy entry, which
* will never match, however, space in the argument entry
* array for this option must be present.
*
* possible modifiers:
* /K - key attribute
* require the specification of one of the option's alias
* names as the ToolType name - excludes the possibilty of
* specifying empty ("") aliases. This attribute is
* implicitely specified with the /S and /T option types.
* /A - always attribute
* this attribute causes ReadArgsTT() to fail if the
* respective argument entry could not be filled from the
* supplied ToolType array handles.
*
* Priority of filling up arguement entries:
* String entries are filled first, then Numeric entries,
* then Switch entries, then Toggle entries, then
* MultiNum entries, then FullRest (/F) entries, and
* at last Multi entries. In addition, all matching name
* aliases that are not empty ("") are filled before any
* entry of any type whatsoever that only matches because
* of an empty name alias match (Empty name aliases match
* any tooltype whatsoever, and their possible name part
* is considered to be part of the value string!) The
* priority is also broken by the 'NO'-prefix equality
* match of /S and /T -type option entries: Any exact
* match of any not empty name alias is preferred to them.
*
* Two remarks of significance: One ToolType may -of course-
* only match one option entry, and any name alias may only
* occure once -except for /I ignore type options: they are
* always ignored- otherwise, failure is returned.
*
* args - an array or structure to hold the argument entries -
* four bytes per template option large at least. You may
* predefine the entries with your default values: if no
* valid matching tooltype is found, and successfully
* processed, no changes are made to the pertinent entry.
* However, if ReadArgsTT() returns failure, you may _NOT_
* assume, that no changes have been made to the predefined
* defaults.
*
* ttTool & - ordinary, 'conventional' ToolType array handles, as
* ttProject opposed to dynamic ones (which can be converted to
* conventional ones by TTAPtr() ). May be NIL or simple
* Exec.APTRs, etc.
*
* flags - No, One or several of noFullMulti, noMultiMulti,
* multiBarSep, multiCommaSep, disableSpecialNo,
* dontFill, allowAskArg, askEmpty & askEmptyOnAlways.
* dontFill has the effect that the args argument
* is ignored, thus you won't get any values of the
* template options specified within the ToolTypes reported.
* This is useful when you want to use this function solely
* as an inclusion/exclusion filter for your ToolTypes.
* The allowAskArg, askEmpty & askEmptyOnAlways flags control
* the popping of argument requesters on systems that run
* reqtools.library V38 or higher:
* - allowAskArg enables user control of popping:
* Every successfully processed ToolType entry that
* matches because of any non-empty template name alias
* that has a magic 'ASK:' - prefix in front of the
* ToolType name itself will pop a string requester
* that asks you for a valid argument string for that
* entry.
* - askEmpty makes ReadArgsTT() pop a requester for each
* template entry that couldn't be filled from the supplied
* ToolTypes.
* - askEmptyOnAlways has exactly the same effect as askEmpty
* except that only requesters for required (/A) template
* entries are popped.
* The description of the other flags is given in the
* section about the tmpl input argument. NOTE: DON'T
* specify any OTHER flags, since strange things may happen
* if you specify flags apart from those documented here!!
*
* RESULT
* RDArgsWBPtr
* - A pointer to a RECORD RDArgsWB, which contains
* two dynamic ToolType array handles, one containing
* all ToolTypes that have been used while parsing the
* template, and one with all those ToolTypes that
* remain unparsed. You can manipulate them using
* the dynamic ToolType array manipulation functions
* of this module. This gives an enormous burst of
* versatility and usefulness for this function - you
* can use it just to filter normal ToolTypes arrays
* multiple times, discarding the Dos.ReadArgs()
* functionality of this function.
* NIL is this function's failure indicator.
*
*
* NOTES
* Remember what I said in the discussion of the flags input parameter
* section.
*
* SEE ALSO
* FreeArgsWB(), ReadArgsWBMsg(), ReadArgsWB(), TTAPtr()
*
*****************************************************************************)
PROCEDURE^ SubPtr * (a, b: e.APTR): e.APTR;
PROCEDURE ReadArgsTT * (tmpl : ARRAY OF CHAR;
args : ARRAY OF y.BYTE;
ttTool, ttProject: TTPtr;
flags : SET ): RDArgsWBPtr;
VAR
ToolEnd, ProjectEnd : BOOLEAN;
ttCurr : LONGINT;
tt : LongStrPtr;
TmplArr : TemplArrT;
Rda : RDArgsWBPtr;
i,j : LONGINT;
ret, status, fnd : LONGINT;
ttUsed : BOOLEAN;
ReqBuf, ReqStr, ReqTitle: DynStrPtr;
PROCEDURE CleanUp(err: LONGINT);
BEGIN
DISPOSE (ReqBuf); DISPOSE (ReqStr); DISPOSE (ReqTitle);
FreeTemplArr (TmplArr);
IF (err # 0) & (d.IoErr() = 0) THEN
y.SETREG (0, d.SetIoErr (err));
END;
END CleanUp;
PROCEDURE GetTT(): LongStrPtr;
BEGIN
IF ~ProjectEnd THEN
IF ttProject # NIL THEN
IF ttProject^[ttCurr] # NIL THEN
INC (ttCurr);
RETURN ttProject^[ttCurr-1];
END;
END;
ProjectEnd := TRUE;
ttCurr:=0;
END;
IF ToolEnd THEN
RETURN NIL;
END;
IF ttTool # NIL THEN
IF ttTool^[ttCurr] # NIL THEN
INC (ttCurr);
RETURN ttTool^[ttCurr-1];
END;
END;
ToolEnd := TRUE;
RETURN NIL;
END GetTT;
PROCEDURE ParseTemplate(): BOOLEAN;
VAR
i, j, n : LONGINT;
fl : SET;
el : INTEGER;
type : LONGINT;
chr : ARRAY 2 OF CHAR;
s : DynStrPtr;
AllNames: DynTTPtr;
to : TemplOptPtr;
fakeargs: ARRAY 4 OF y.BYTE;
PROCEDURE CleanUp ();
BEGIN
DISPOSE (s);
FreeDynTT (AllNames);
END CleanUp;
PROCEDURE ClrOptVars(): BOOLEAN;
BEGIN
fl := flags * TemplOptFlagsMask;
type := str;
DISPOSE (s);
RETURN DynAppend (s, "");
END ClrOptVars;
BEGIN
i := 0; n := 0; chr[1] := '\x00'; s := NIL; AllNames := NIL;
LOOP
CASE tmpl[i] OF
'\x00' : EXIT; |
',' : INC (n);
ELSE END;
INC (i);
END;
IF i # 0 THEN INC (n); END;
IF n = 0 THEN CleanUp(); RETURN TRUE; END;
IF ~DynAppendTT (AllNames, "", {createEmpty}) THEN CleanUp(); RETURN FALSE; END;
y.ALLOCATE (TmplArr, n);
IF TmplArr = NIL THEN CleanUp(); RETURN FALSE; END;
FOR i := 0 TO LEN (TmplArr^)-1 DO TmplArr[i] := NIL; END;
i := 0; n := 0;
IF ~ClrOptVars() THEN CleanUp(); RETURN FALSE; END;
LOOP
CASE tmpl[i] OF
'\x00', ',':
IF (numAttr IN fl) THEN
LOOP
IF type = str THEN type := num; EXIT; END;
IF type = multi THEN type := multiNum; EXIT; END;
CleanUp(); RETURN FALSE;
END;
EXCL (fl, numAttr);
END;
CASE type OF
ignore : y.ALLOCATE (TmplArr[n] (TemplIgnore)); |
str : y.ALLOCATE (TmplArr[n] (TemplStr)); |
switch : y.ALLOCATE (TmplArr[n] (TemplSwitch)); |
num : y.ALLOCATE (TmplArr[n] (TemplNum)); |
toggle : y.ALLOCATE (TmplArr[n] (TemplToggle)); |
multiNum: y.ALLOCATE (TmplArr[n] (TemplMultiNum)) |
remain : y.ALLOCATE (TmplArr[n] (TemplRemain)); |
multi : y.ALLOCATE (TmplArr[n] (TemplMulti));
END;
IF TmplArr[n] = NIL THEN CleanUp(); RETURN FALSE; END;
IF dontFill IN flags THEN
e.CopyMem ("\000\000\000\000", fakeargs, LEN (fakeargs));
IF ~TmplArr[n].Init (s^, fakeargs[0], fl, AllNames) THEN CleanUp(); RETURN FALSE; END;
ELSE
IF ~TmplArr[n].Init (s^, args[4*n], fl, AllNames) THEN CleanUp(); RETURN FALSE; END;
END;
IF ~ClrOptVars() THEN CleanUp(); RETURN FALSE; END;
INC (n);
IF tmpl[i] = '\x00' THEN EXIT; END; |
'/' :
WHILE tmpl[i] = '/' DO
INC (i);
j := 0;
LOOP
IF j >= LEN (tmplTypesSansNum) THEN EXIT; END;
IF (CAP(tmpl[i]) = tmplTypesSansNum[j]) &
(tmplTypesSansNum[j] # CHR (0)) THEN EXIT; END;
INC (j);
END;
IF j < LEN (tmplTypesSansNum) THEN
IF type # str THEN CleanUp(); RETURN FALSE; END;
type := j;
ELSE
CASE CAP(tmpl[i]) OF
numC:
el := numAttr; | (* new special num type handling *)
keyC:
el := keyAttr; |
alwaysC:
el := alwaysAttr;
ELSE
CleanUp(); RETURN FALSE;
END;
IF el IN fl THEN CleanUp(); RETURN FALSE; END;
INCL (fl, el);
END;
INC (i);
END; (* WHILE *)
CASE tmpl[i] OF
',', '\x00': |
ELSE
CleanUp(); RETURN FALSE;
END;
DEC (i);
ELSE
chr[0] := tmpl[i];
IF ~DynAppend (s, chr) THEN CleanUp(); RETURN FALSE; END;
END; (* CASE *)
INC (i);
END; (* LOOP *)
FOR i:=0 TO LEN (TmplArr^)-1 DO (* sorting *)
FOR j:=i+1 TO LEN (TmplArr^)-1 DO
IF TmplArr[j].pri<TmplArr[i].pri THEN
to := TmplArr[i]; TmplArr[i] := TmplArr[j]; TmplArr[j] := to;
END;
END;
END;
CleanUp();
RETURN TRUE;
END ParseTemplate;
PROCEDURE RequestArg (VAR opt: TemplOpt): LongStrPtr;
VAR
ls : LStrPtr;
i,diff: LONGINT;
me : d.ProcessPtr;
BEGIN
IF req = NIL THEN RETURN NIL; END;
IF ReqTitle = NIL THEN
IF ~DynExpand (ReqTitle, 256) THEN DISPOSE (ReqTitle); RETURN NIL; END;
me := e.FindTask (NIL);
IF me.cli = NIL THEN
IF me.task.node.name # NIL THEN
IF ~DynAppend (ReqTitle, me.task.node.name^) THEN DISPOSE (ReqTitle); RETURN NIL; END;
END;
ELSE
IF ~d.GetProgramName (ReqTitle^, LEN (ReqTitle^)) THEN DISPOSE (ReqTitle); RETURN NIL; END;
END;
IF ~DynAppend (ReqTitle,
GetCatalogStr (bs.DefaultCatalog, bs.titleReadArgsRequest)^) THEN
DISPOSE (ReqTitle); RETURN NIL;
END;
END;
DISPOSE (ReqStr);
IF ReqBuf = NIL THEN
ReqBuf := opt.EntryToTT ();
ELSE
diff := SubPtr (GetToolValue (ReqBuf^), StrIndex (ReqBuf^, 0));
FOR i := diff TO st.Length (ReqBuf^) DO ReqBuf[i-diff] := ReqBuf [i]; END;
END;
IF ReqBuf = NIL THEN RETURN NIL; END;
ReqStr := opt.ReqPrompt ();
IF ReqStr = NIL THEN RETURN NIL; END;
IF alwaysAttr IN opt.flags THEN
IF ~DynAppend (ReqStr, GetCatalogStr (bs.DefaultCatalog, bs.msgWarnArgRequired)^) THEN RETURN NIL; END;
END;
IF ~DynExpand (ReqStr, st.Length (ReqStr^)+2000) THEN RETURN NIL; END;
ls := StrIndex (ReqStr^, 0);
IF ~rtGetString (ReqBuf^, LEN (ReqBuf^)-1, ReqTitle^, NIL, gsTextFmt,
StrIndex ("%s", 0), gsAllowEmpty, I.LTRUE,
gsFlags, LONGSET{gsReqCenterText},
gsTextFmtArgs, y.ADR (ls), u.done) THEN RETURN NIL; END;
IF ~DynInsert (ReqBuf, 0, "=") THEN RETURN NIL; END;
IF ~DynInsert (ReqBuf, 0, opt.names[0]^) THEN RETURN NIL; END;
RETURN StrIndex (ReqBuf^, 0);
END RequestArg;
(* $CopyArrays- *)
BEGIN
ReqBuf := NIL; ReqStr := NIL; ReqTitle := NIL;
ToolEnd := FALSE; ProjectEnd := FALSE; ttCurr := 0; TmplArr := NIL; Rda := NIL;
status := fail;
y.SETREG (0, d.SetIoErr (0));
IF ~ParseTemplate() THEN CleanUp (d.badTemplate); RETURN NIL; END;
y.ALLOCATE (Rda);
IF Rda = NIL THEN CleanUp(d.noFreeStore); RETURN NIL; END;
Rda.opts := NIL; Rda.ttRest := NIL; Rda.ttIncl := NIL; Rda.validCD := FALSE;
IF ~DynAppendTT (Rda.ttRest, "", {createEmpty}) THEN CleanUp(d.noFreeStore); RETURN NIL; END;
IF ~DynAppendTT (Rda.ttIncl, "", {createEmpty}) THEN CleanUp(d.noFreeStore); RETURN NIL; END;
LOOP
tt := GetTT();
IF tt = NIL THEN EXIT; END;
i := 0; status := fail; ttUsed := FALSE;
LOOP
IF TmplArr = NIL THEN EXIT; END;
IF i >= LEN (TmplArr^) THEN EXIT; END;
fnd := TmplArr[i].Cmp (TmplArr[i].SkipAskMagic (tt^, notFound)^, status);
IF fnd = foundNoSpc THEN
FOR j:=i+1 TO LEN (TmplArr^)-1 DO
IF TmplArr[j].Cmp (TmplArr[i].SkipAskMagic (tt^, notFound)^, status) = found THEN fnd := notFound; END;
END;
END;
IF fnd # notFound THEN
ret := TmplArr[i].Process (TmplArr[i].SkipAskMagic (tt^, fnd)^);
IF ret # fail THEN
ttUsed := TRUE;
IF TmplArr[i].SkipAskMagic (tt^, fnd) # tt THEN
INCL (TmplArr[i].flags, requestArg);
END;
END;
IF ret = ok THEN
EXIT;
ELSIF (ret = okSwitchT) OR (ret = okSpecNo) THEN
status := ret;
END;
END;
INC (i);
END; (* LOOP *)
IF ~ttUsed THEN
IF ~DynAppendTT (Rda.ttRest, tt^, {}) THEN CleanUp(d.noFreeStore); RETURN NIL; END;
ELSE
IF ~DynAppendTT (Rda.ttIncl, tt^, {}) THEN CleanUp(d.noFreeStore); RETURN NIL; END;
END;
END; (* LOOP *)
IF TmplArr # NIL THEN
FOR i:= 0 TO LEN (TmplArr^)-1 DO
IF ((~TmplArr[i].used & ((askEmpty IN flags) OR
((askEmptyOnAlways IN flags) & (alwaysAttr IN TmplArr[i].flags)))) OR
(requestArg IN TmplArr[i].flags)) & (req # NIL) THEN
DISPOSE (ReqBuf);
TmplArr[i].flags := TmplArr[i].flags - {noMultiMulti,noFullMulti} + {requestArg};
LOOP
tt := RequestArg(TmplArr[i]^);
IF tt = NIL THEN TmplArr[i].Free ({solelyMakeUnused}); EXIT; END;
ret := TmplArr[i].Cmp (tt^, fail);
IF ret = notFound THEN EXIT; END;
TmplArr[i].Free ({solelyMakeUnused});
IF TmplArr[i].Process (tt^) # fail THEN EXIT; END;
END; (* LOOP *)
END;
IF alwaysAttr IN TmplArr[i].flags THEN
IF ~TmplArr[i].used THEN CleanUp(d.requiredArgMissing); RETURN NIL; END;
END;
END;
END;
Rda.opts := TmplArr; TmplArr := NIL;
CleanUp(0);
RETURN Rda;
END ReadArgsTT;
(****** BlackMagic/FreeArgs ***************************************************
*
* NAME
* FreeArgs -- Frees resources allocated with ReadArgs()
*
* SYNOPSIS
* FreeArgs (VAR rda: RDArgsPtr);
*
* FUNCTION
* This function just frees all resources allocated with a prior
* call to ReadArgs() and reinitializes the RDArgsPtr to NIL.
*
* INPUTS
* rda - A valid or NIL RDArgsPtr
*
* SEE ALSO
* ReadArgs()
*
*****************************************************************************)
PROCEDURE FreeArgs * (VAR rda: RDArgsPtr);
BEGIN
IF rda # NIL THEN
rda.Free();
DISPOSE (rda);
END;
END FreeArgs;
(****** BlackMagic/FreeArgsWB *************************************************
*
* NAME
* FreeArgsWB -- Frees resources allocated with ReadArgsTT/WBMsg/WB()
*
* SYNOPSIS
* FreeArgsWB (VAR rda: RDArgsWBPtr);
*
* FUNCTION
* This function just frees all resources allocated with a prior
* call to ReadArgsTT(), ReadArgsWBMsg() or ReadArgsWB() and
* reinitializes the RDArgsWBPtr to NIL.
*
* INPUTS
* rda - A valid or NIL RDArgsWBPtr
*
* SEE ALSO
* ReadArgsTT(), ReadArgsWBMsg(), ReadArgsWB()
*
*****************************************************************************)
PROCEDURE FreeArgsWB * (VAR rda: RDArgsWBPtr);
BEGIN
IF rda # NIL THEN
rda.Free();
DISPOSE (rda);
END;
END FreeArgsWB;
(****** BlackMagic/WBArgToFNam *************************************************
*
* NAME
* WBArgToFNam -- generates complete file path from filename & dir lock
*
* SYNOPSIS
* WBArgToFNam * (VAR string : DynStrPtr;
* lock : d.FileLockPtr;
* fName : ARRAY OF CHAR;
* flags : SET): BOOLEAN;
*
* FUNCTION
* This function generates the complete path of a file from
* its name component and a lock of the directory where
* the file is located, and appends it to the passed dynamic
* string. This function is especially useful when dealing
* with WBStartup / AppMessage file lists. Note that you
* can alienate this function from its original purpose by
* supplying an empty fName parameter. In that case, this
* function simply returns the complete path of the supplied
* lock parameter.
*
* INPUTS
* string - the dynamic string handle - may be NIL.
* lock - the lock of the directory where the file is located.
* fName - the name of the file.
* flags - flags modifying the operation of this function.
* At the moment, the one and only documented flag is
* relPath. If you specify it, this function may
* generate relative paths to the current directory,
* otherwise it will always create absolute paths.
* It is *absolutely illegal* to specify any other
* flags than the ones documented here.
*
* RESULT
* TRUE - for success.
* FALSE - for failure - in this case the dynamic string and its
* handle are left unchanged.
*
* SEE ALSO
* ReadArgsWBMsg()
*
*****************************************************************************)
PROCEDURE WBArgToFNam * (VAR string : DynStrPtr;
lock : d.FileLockPtr;
fName : ARRAY OF CHAR;
flags : SET): BOOLEAN;
VAR
FullPathStr: DynStrPtr;
i: LONGINT;
PROCEDURE CleanUp();
BEGIN
DISPOSE (FullPathStr);
END CleanUp;
(* $CopyArrays- *)
BEGIN
FullPathStr := NIL;
IF (d.SameLock (lock, e.FindTask (NIL)(d.Process).currentDir) # d.same) OR
~(relPath IN flags) THEN
i := 1+DynamicExtra;
LOOP
y.ALLOCATE (FullPathStr, i);
IF FullPathStr = NIL THEN CleanUp(); RETURN FALSE; END;
IF d.NameFromLock (lock, FullPathStr^,
LEN (FullPathStr^)) THEN
EXIT;
ELSE
IF d.IoErr() # d.lineTooLong THEN CleanUp(); RETURN FALSE; END;
END;
INC (i, 1+DynamicExtra);
DISPOSE (FullPathStr);
END; (* LOOP *)
END;
IF ~DynExpand (FullPathStr, DynStrLen (FullPathStr)+st.Length (fName)+2) THEN
CleanUp(); RETURN FALSE;
END;
IF fName # "" THEN
IF ~d.AddPart (FullPathStr^, fName,
LEN (FullPathStr^)) THEN CleanUp(); RETURN FALSE; END;
END;
IF ~DynAppend (string, FullPathStr^) THEN CleanUp(); RETURN FALSE; END;
CleanUp();
RETURN TRUE;
END WBArgToFNam;
(****** BlackMagic/ReadArgsWBMsg **********************************************
*
* NAME
* ReadArgsWBMsg -- Parse WBStartup's input similar to Dos.ReadArgs()
*
* SYNOPSIS
* ReadArgsWBMsg (template : ARRAY OF CHAR;
* args : ARRAY OF y.BYTE;
* wbenchMsg: wb.WBStartupPtr;
* project : LONGINT;
* flags : SET): RDArgsWBPtr;
*
* FUNCTION
* This function is a frontend for the ReadArgsTT() function.
* Its main additional benefit is that it does all the bothersome
* DiskObject handling and provides the capability to pass the
* project(s)'s file names you supply as arguments for your tool
* invocation. All ToolTypes of the project (if specified) are
* searched for a match and are processed before the tool's
* ToolTypes, as demanded in the Amiga User Interface Style Guide.
*
* INPUTS
* template- The option template. Have a look at the ReadArgsTT
* documentation for a thorough-going discussion.
*
* args - The array or struct to hold the option argument entries.
* Four bytes for each option large at least. See also
* ReadArgsTT() documentation.
*
* wbenchMsg- The WBStartup you were passed by Workbench on
* startup of your program. For Oberon you can access it
* with OberonLib.wbStartup
*
* project - The ordinal number of the project you want to be taken
* into account for parsing - starting at 1. Passing 0
* means that you only want the tool's ToolTypes to be
* taken into account. Passing -1 means that if there
* exist one or more passed projects, the first project
* is used for parsing, otherwise only the tool's ToolTypes
* are taken into account. The number of projects supplied
* may be calculated using wbenchMsg^.numArgs-1
*
* flags - Flags modifying the operation of this function:
* You may use all those documented with ReadArgsTT,
* including noFullMulti, noMultiMulti, multiBarSep,
* multiCommaSep, disableSpecialNo & dontFill.
* There are six more flags you may specify along with
* this function:
* doCD:
* Make the directory specified by the directory lock of
* WBStartup's tool the current directory. A call to
* FreeArgsWB() will reset the original current
* directory.
* ignoreTool:
* Discard the tool's ToolTypes, only consider the
* project's ToolTypes. Incompatible with specifying 0
* as project parameter and with ignoreProject
* ignoreProject:
* Discard the project's ToolTypes, only consider the
* tools's ToolTypes. Incompatible with ignoreTool
* argFile, argFiles & relPath:
* If you specify exactly one of either argFile or
* argFiles, and you pass either a FILE/K or a
* a FILES/M/K template option, the respective option
* entries will either be filled with the file name
* of the specified project or with all file names of
* all projects passed on startup.
* File name(s) are either always given as an absolute
* path (default) or may have a path relative to the
* tool's current directory if you specify the relPath
* flag.
*
* RESULT
* RDArgsWBPtr
* - A pointer to a RECORD RDArgsWB, as documented along
* with the ReadArgsTT() doc. NIL indicates failure.
*
* NOTES
* Remember what I said in the discussion of unauthorized flag
* specification in the ReadArgsTT() and also in the DynAppendTT()
* documentation.
*
* SEE ALSO
* FreeArgsWB(), ReadArgsTT(), ReadArgsWB()
*
*****************************************************************************)
PROCEDURE ReadArgsWBMsg * (template : ARRAY OF CHAR;
args : ARRAY OF y.BYTE;
wbenchMsg: wb.WBStartupPtr;
project : LONGINT;
flags : SET): RDArgsWBPtr;
VAR
do1, do2: wb.DiskObjectPtr;
lock: d.FileLockPtr;
rda: RDArgsPtr;
rdareturn: RDArgsWBPtr;
ArgStr: DynStrPtr;
endflg : BOOLEAN;
i: LONGINT;
tmpl: LongStrPtr;
av: ARRAY 4 OF y.BYTE;
tt1, tt2: TTPtr;
fprj: LONGINT;
cd: d.FileLockPtr;
wba: WBArgumentsPtr;
(* $CopyArrays- *)
BEGIN
do1 := NIL; do2 := NIL; lock := NIL; rda := NIL; rdareturn := NIL;
ArgStr := NIL; endflg := FALSE; i := 0; tmpl := NIL; tt1 := NIL; tt2 := NIL;
IF ((argFile IN flags) & (argFiles IN flags)) OR
((ignoreTool IN flags) & ((ignoreProject IN flags) OR (project=0))) THEN
y.SETREG (0, d.SetIoErr (d.objectWrongType)); RETURN NIL;
END;
IF argFile IN flags THEN
tmpl := y.ADR ("FILE/M/K");
ELSIF argFiles IN flags THEN
tmpl := y.ADR ("FILES/M/K");
ELSE
tmpl := y.ADR ("");
END;
IF wbenchMsg = NIL THEN y.SETREG (0, d.SetIoErr (d.objectWrongType)); RETURN NIL; END;
IF project = -1 THEN
IF wbenchMsg^.numArgs > 1 THEN project := 1; ELSE project := 0; END;
END;
IF (project < 0) OR (project >= wbenchMsg^.numArgs) THEN
y.SETREG (0, d.SetIoErr (d.badNumber)); RETURN NIL;
END;
IF (project=0) & (wbenchMsg^.numArgs>1) THEN fprj := 1; ELSE fprj := project; END;
(* due to misdefinition of wb.WBArgumentsPtr: Ptr TO ARRAY 256!! OF ... *)
wba := AddPtr (wbenchMsg.argList, 0);
IF doCD IN flags THEN cd := d.CurrentDir (wba^[0].lock); END;
lock := d.CurrentDir (wba^[0].lock);
do1 := ic.GetDiskObjectNew (wba^[0].name^);
y.SETREG (0, d.CurrentDir (wba^[project].lock));
do2 := ic.GetDiskObjectNew (wba^[project].name^);
y.SETREG (0, d.CurrentDir (lock));
IF ignoreTool IN flags THEN tt1 := NIL; ELSE tt1 := do1^.toolTypes; END;
IF ((project = 0) OR (ignoreProject IN flags)) &
(tt1 # NIL) THEN tt2 := NIL; ELSE tt2 := do2^.toolTypes; END;
LOOP
IF ~DynAppend (ArgStr, "") THEN EXIT; END;
rda := ReadArgsTT (tmpl^, av, tt1, tt2, {});
IF rda = NIL THEN EXIT; END;
WITH rda: RDArgsWB DO
IF (argFile IN flags) & (fprj > 0) THEN
ArgStr[0] := CHR (0);
IF ~DynAppend (ArgStr, "FILE=") THEN EXIT; END;
(* due to misdefinition of wb.WBArgumentsPtr: Ptr TO ARRAY 256!! OF ... *)
IF ~WBArgToFNam (ArgStr, wba^[fprj].lock, wba^[fprj].name^,
flags) THEN EXIT; END;
IF ~DynAppendTT (rda.ttRest, ArgStr^, {}) THEN EXIT; END;
END;
IF argFiles IN flags THEN
FOR i := 1 TO wbenchMsg^.numArgs-1 DO
ArgStr[0] := CHR (0);
(* due to misdefinition of wb.WBArgumentsPtr: Ptr TO ARRAY 256!! OF ... *)
IF ~DynAppend (ArgStr, "FILES=") THEN EXIT; END;
IF ~WBArgToFNam (ArgStr, wba^[i].lock, wba^[i].name^, flags) THEN EXIT; END;
IF ~DynAppendTT (rda.ttRest, ArgStr^, {}) THEN EXIT; END;
END; (* FOR *)
END; (* IF argFiles IN flags *)
rdareturn := ReadArgsTT (template, args, NIL, TTAPtr (rda.ttRest), flags);
EXIT;
END (* WITH *)
END; (* LOOP *)
IF rda # NIL THEN FreeArgs (rda); END;
IF do1 # NIL THEN ic.FreeDiskObject (do1); END;
IF do2 # NIL THEN ic.FreeDiskObject (do2); END;
DISPOSE (ArgStr);
IF doCD IN flags THEN
IF rdareturn # NIL THEN
rdareturn.validCD := TRUE; rdareturn.oldCD := cd;
ELSE
y.SETREG (0, d.CurrentDir (cd));
END;
END;
RETURN rdareturn;
END ReadArgsWBMsg;
(****** BlackMagic/ReadArgsWB *************************************************
*
* NAME
* ReadArgsWB -- Parse Workbench input within an Oberon program
*
* SYNOPSIS
* ReadArgsWB (template: ARRAY OF CHAR;
* args : ARRAY OF y.BYTE;
* project : LONGINT;
* flags : SET): RDArgsWBPtr;
*
* FUNCTION
* This function is a frontend for the ReadArgsWBMsg() function
* to be used in Oberon programs. The arguments passed to it are
* exactly the same as the ones passed to ReadArgsWBMsg() except
* for the omitted wbenchMsg arguement which is directly taken
* from OberonLib.wbStartup. If the Oberon program was started from
* CLI, failure is returned.
*
* INPUTS
* see ReadArgsWBMsg() documentation
*
* RESULT
* RDArgsWBPtr
* - A pointer to a RECORD RDArgsWB, as documented along
* with the ReadArgsTT() doc, NIL for failure.
*
* NOTES
* Remember what I said in the discussion of unauthorized flag
* specification in the ReadArgsTT() and also in the DynAppendTT()
* documentation.
*
* SEE ALSO
* FreeArgsWB(), ReadArgsTT(), ReadArgsWBMsg()
*
*****************************************************************************)
PROCEDURE ReadArgsWB * (template: ARRAY OF CHAR;
args : ARRAY OF y.BYTE;
project : LONGINT;
flags : SET): RDArgsWBPtr;
(* $CopyArrays- *)
BEGIN
IF ~o.wbStarted THEN y.SETREG (0, d.SetIoErr (d.objectWrongType)); RETURN NIL; END;
RETURN ReadArgsWBMsg (template, args, o.wbenchMsg(wb.WBStartup),
project, flags);
END ReadArgsWB;
(****** BlackMagic/ReadArgs ***************************************************
*
* NAME
* ReadArgs -- Parse Workbench OR CLI input args Dos.ReadArgs()-like
*
* SYNOPSIS
* ReadArgs (template: ARRAY OF CHAR;
* args : ARRAY OF y.BYTE;
* project : LONGINT;
* flags : SET): RDArgsWBPtr;
*
* FUNCTION
* This function provides all Oberon programmers with a unique
* argument parsing interface, from both CLI and Workbench.
* It offers you all of the flexibility of the Dos.ReadArgs()
* function also for Workbench argument parsing.
*
* INPUTS
* see ReadArgsWBMsg() documentation
* Note that for CLI parsing, the project and flags paramters
* are naturally ignored, since they are Workbench specific. You
* may only use template option combinations that are documented
* for both, ReadArgsTT() AND dos/ReadArgs(), of course.
*
* RESULT
* RDArgsPtr
* - A pointer to a RECORD RDArgs or NIL.
* You may free the resources allocated with it by
* invoking FreeArgs (RDArgsPtr).
*
* NOTES
* Remember what I said in the discussion of unauthorized flag
* specification in the ReadArgsTT() and also in the DynAppendTT()
* documentation.
*
* SEE ALSO
* FreeArgs(), ReadArgsTT(), ReadArgsWBMsg(), ReadArgsWB()
*
*****************************************************************************)
PROCEDURE ReadArgs * (template: ARRAY OF CHAR;
args : ARRAY OF y.BYTE;
project : LONGINT;
flags : SET): RDArgsPtr;
VAR
rda: RDArgsPtr;
(* $CopyArrays- *)
BEGIN
rda := NIL;
IF o.wbStarted THEN
rda := ReadArgsWBMsg (template, args, o.wbenchMsg(wb.WBStartup),
project, flags);
ELSE
y.ALLOCATE (rda (RDArgsCLI));
IF rda # NIL THEN
rda (RDArgsCLI).rda := d.OldReadArgs (template, args, NIL);
IF rda (RDArgsCLI).rda = NIL THEN DISPOSE (rda); END;
END;
END;
RETURN rda;
END ReadArgs;
(****** BlackMagic/ArgsToTT ***************************************************
*
* NAME
* ArgsToTT -- Convert a string/CLIArgs into a dynamic ToolType array
*
* SYNOPSIS
* ArgsToTT (str: ARRAY OF CHAR, flags: SET): DynTTPtr;
*
* FUNCTION
* This function does 'CLI to WB parsing' for you, as opposed to the
* ReadArgsTT/WBMsg/WB() functions which parse the other way round.
* It simply stores each of the white-space separated 'words' of the
* input string into an own entry of a dynamic ToolType array. Usual
* dos escaping like *n, *e, ** inside quotes is done because this
* function uses Dos.ReadArgs().
*
* INPUTS
* str - the string to be parsed
* flags - flags that modify operation of this function.
* currently only useCLIArgs may be specified, which
* causes ArgsToTT to ignore the passed string and get
* its input rather from the arguemnts passed to your
* program by the shell on startup.
*
* RESULT
* DynTTPtr - The dynamic ToolType array handle whose ToolTypes
* represent the input source's string. The array may
* be empty, i.e. its first element may be NIL if the
* input string was empty or consisted solely of white
* space characters. A NIL return is this function's
* failure indicator.
*
* NOTES
* Dos.ReadItem()/Dos.ReadArgs() parse all '=' equal characters into
* white space, if they're not surrounded by quotes. Remember this.
* Concerning the flags parameter, keep in mind what I said in the
* DynAppendTT documentation about using unauthorized flags for
* the flags paramter!
*
* SEE ALSO
* FreeDynTT(), DynAppendTT(), ReadArgsTT()
*
*****************************************************************************)
(* Flags for ArgsToTT *)
CONST
useCLIArgs * = 0;
PROCEDURE ArgsToTT * (str: ARRAY OF CHAR; flags: SET): DynTTPtr;
VAR
rda1, rda2: d.RDArgsPtr;
dtt, dttnf: DynTTPtr;
Args: TTPtr;
i : LONGINT;
PROCEDURE CleanUp();
BEGIN
FreeDynTT (dtt);
IF rda2 # NIL THEN d.FreeArgs (rda2); rda2 := NIL; END;
IF rda1 # NIL THEN d.FreeDosObject (d.rdArgs, rda1); rda1 := NIL; END;
END CleanUp;
(* $CopyArrays- *)
BEGIN
rda1 := NIL; rda2 := NIL; dtt := NIL; dttnf := NIL; Args := NIL;
IF ~(useCLIArgs IN flags) THEN
rda1 := d.AllocDosObject (d.rdArgs, NIL);
IF rda1 = NIL THEN CleanUp(); RETURN NIL; END;
rda1.source.buffer := y.ADR (str);
rda1.source.length := st.Length (str);
rda1.source.curChr := 0;
rda1.daList := NIL; rda1.buffer := NIL; rda1.bufSiz := 0; rda1.extHelp := NIL;
rda1.flags := LONGSET{d.noPrompt};
END;
rda2 := d.OldReadArgs ("/M", Args, rda1);
IF rda2 = NIL THEN CleanUp(); RETURN NIL; END;
IF ~DynAppendTT (dtt, "", {createEmpty}) THEN CleanUp(); RETURN NIL; END;
IF Args # NIL THEN
i := 0;
WHILE Args[i] # NIL DO
IF ~DynAppendTT (dtt, Args[i]^, {}) THEN CleanUp(); RETURN NIL; END;
INC (i);
END;
END;
dttnf := dtt; dtt := NIL;
CleanUp();
RETURN dttnf;
END ArgsToTT;
(****** BlackMagic/AddPtr *****************************************************
*
* NAME
* AddPtr -- Add UNTRACED (B)POINTERs/integers/LONGSETs
*
* SYNOPSIS
* AddPtr (a: Exec.APTR; b: Exec.APTR): Exec.APTR;
*
* FUNCTION
* This function provides mixed untraced pointer/integer arithmetics
* for you, no matter whether the passed values are Exec.APTRS,
* BPOINTERs, integers or LONGSETs
* It takes the two values (and corrects any BPOINTER values), adds
* them, and returns the result as an Exec.APTR.
*
* INPUTS
* a,b - the values to perform the addition on.
*
* RESULT
* Exec.APTR - the result of the performed arithmetics returned as an
* Exec.APTR.
*
* NOTES
* *Never* try to use this function with traced pointers arguments.
*
* SEE ALSO
* SubPtr(), StrIndex(), PtrToInt()
*
*****************************************************************************)
PROCEDURE AddPtr * (a, b: e.APTR): e.APTR;
BEGIN
RETURN y.VAL (e.APTR, y.VAL (LONGINT, a) + y.VAL (LONGINT, b));
END AddPtr;
(****** BlackMagic/SubPtr *****************************************************
*
* NAME
* SubPtr -- Subtracts UNTRACED (B)POINTERs/integers/LONGSETs
*
* SYNOPSIS
* SubPtr (a: Exec.APTR; b: Exec.APTR): Exec.APTR;
*
* FUNCTION
* This function provides mixed untraced pointer/integer arithmetics
* for you, no matter whether the passed values are Exec.APTRS,
* BPOINTERs, integers or LONGSETs.
* It takes the b parameter, subtracts it from the a parameter, and
* returns the result as an Exec.APTR (result := a-b;)
*
* INPUTS
* a - the value from which b is to be subtracted
* b - the value to subtract from a.
*
* RESULT
* Exec.APTR - the result of the performed arithmetics returned as an
* Exec.APTR.
*
* NOTES
* *Never* try to use this function with traced pointers arguments.
*
* SEE ALSO
* AddPtr(), StrIndex(), PtrToInt()
*
*****************************************************************************)
PROCEDURE SubPtr * (a, b: e.APTR): e.APTR;
BEGIN
RETURN y.VAL (e.APTR, y.VAL (LONGINT, a) - y.VAL (LONGINT, b));
END SubPtr;
(****** BlackMagic/PtrToInt ****************************************************
*
* NAME
* PtrToInt - Typecast UNTRACED (B)POINTER/integer/LONGSET to LONGINT
*
* SYNOPSIS
* PtrToInt (ptr: Exec.APTR): LONGINT;
*
* FUNCTION
* This function simply typecasts an Exec.APTR into a LONGINT.
* This is useful for pointer arithmetics.
*
* INPUTS
* ptr - the UNTRACED POINTER / BPOINTER / integer / LONGSET
* to be typecasted into LONGINT
*
* RESULT
* the typecasted LONGINT
*
* SEE ALSO
* AddPtr(), SubPtr(), BPtrVal()
*
*****************************************************************************)
PROCEDURE PtrToInt * (ptr: e.APTR): LONGINT;
BEGIN
RETURN y.VAL (LONGINT, ptr);
END PtrToInt;
(****** BlackMagic/BPtrVal *****************************************************
*
* NAME
* BPtrVal - Typecast a BPOINTER to LONGINT
*
* SYNOPSIS
* BPtrVal (bptr: Exec.APTR): LONGINT;
*
* FUNCTION
* This function simply typecasts a BPOINTER into a LONGINT
* without shifting it 2 bits left. Useful for operating system
* TagLists where BPOINTERs have to be passed as real BPOINTERs.
*
*
* INPUTS
* bptr - the BPOINTER to be typecasted into LONGINT
*
* RESULT
* the typecasted LONGINT
*
* SEE ALSO
* PtrToInt(), AddPtr(), SubPtr()
*
*****************************************************************************)
PROCEDURE BPtrVal * (bptr: e.APTR): LONGINT;
BEGIN
RETURN y.VAL (LONGINT, bptr) DIV 4;
END BPtrVal;
(****** BlackMagic/GetCatalogStr ***********************************************
*
* NAME
* GetCatalogStr - Return a localized string from a catalog
* GetCatalogStrA - Return a localized str (Exec.APTR) from a catalog
*
* SYNOPSIS
* GetCatalogStr (catalog: Locale.CatalogPtr;
* string : ARRAY OF CHAR ): LongStrPtr;
*
* GetCatalogStrA (catalog: Locale.CatalogPtr;
* string : ARRAY OF CHAR ): Exec.APTR;
*
* FUNCTION
* These functions are similar to locale.library's GetCatalogStr()
* equivalent, except that they work with a NIL - Locale.base and
* consume one parameter less, because they expect the string id
* to be placed in the two leading chars of the passed string
* (high byte first, then low byte), the actual default string
* is expected to start at the 3rd char of the string.
* For further documentation, have a look at Locale/GetCatalogStr().
*
* INPUTS
* catalog - a valid Locale.CatalogPtr or NIL.
* string - the string containing the string id in the first two
* characters, and the null-terminated default string
* starting from the third character.
*
* RESULT
* a LongStrPtr/Exec.APTR pointing to the 'best' string found.
* Guaranteed to be non-NIL.
*
* NOTES
* you may convert your catalog definition files (#?.cd) into the
* required Oberon source with the string constants definitions in
* the format this function expects, with the enclosed Cat2Mod.rexx
* script.
*
* SEE ALSO
* GetStr(), Locale/GetCatalogStr(), Cat2Mod.rexx
*
*****************************************************************************)
PROCEDURE GetCatalogStr * (catalog: loc.CatalogPtr;
string : ARRAY OF CHAR ): LongStrPtr;
VAR
str1 : LongStrPtr;
str2 : e.APTR;
id : LONGINT;
(* $CopyArrays- *)
BEGIN
str1 := StrIndex (string, 2);
IF loc.base = NIL THEN RETURN str1; END;
id := ASH (ORD (string[0]), 8) + ORD (string[1]);
str2 := loc.GetCatalogStr (catalog, id, str1^);
IF str2 # NIL THEN str1 := str2; END;
RETURN str1;
END GetCatalogStr;
PROCEDURE GetCatalogStrA * (catalog: loc.CatalogPtr;
string : ARRAY OF CHAR ): e.APTR;
(* $CopyArrays- *)
BEGIN
RETURN GetCatalogStr (catalog, string);
END GetCatalogStrA;
(****** BlackMagic/GetStr ******************************************************
*
* NAME
* GetStr - Return a localized string from the default catalog
* GetStrA - Return localized str (Exec.APTR) from the default catalog
*
* SYNOPSIS
* GetStr (string: ARRAY OF CHAR): LongStrPtr;
*
* GetStrA (string: ARRAY OF CHAR): Exec.APTR;
*
* FUNCTION
* These functions are frontends for the GetCatalogStr() function.
* They take only the string parameter, and use the contents of
* BlackMagic.Default as GetCatalogStr()'s catalog argument.
*
* INPUTS
* string - the string containing the string id in the first two
* characters, and the null-terminated default string
* starting from the third character.
*
* RESULT
* a LongStrPtr/Exec.APTR pointing to the 'best' string found -
* guaranteed to be non-NIL;
*
* NOTES
* You should open your program's catalog in your initialization code
* and assign the value returned by Locale.OpenCatalog() to the
* BlackMagic.DefaultCatalog variable. After that GetStr() / GetStrA()
* do anything for you, you _MUST NOT_ even close the Catalog since
* that is done in this module's shutdown code. However, if you
* omit opening your catalog at startup, this function will
* still work - it simply returns the built-in strings in that case.
* If you convert your catalog definitions with the enclosed
* Cat2Mod.rexx script, this initialization is done in the
* generated Oberon source module.
*
* SEE ALSO
* GetCatalogString(), Cat2Mod.rexx
*
*****************************************************************************)
VAR
DefaultCatalog * : loc.CatalogPtr;
PROCEDURE GetStr * (string: ARRAY OF CHAR): LongStrPtr;
(* $CopyArrays- *)
BEGIN
RETURN GetCatalogStr (DefaultCatalog, string);
END GetStr;
PROCEDURE GetStrA * (string: ARRAY OF CHAR): e.APTR;
(* $CopyArrays- *)
BEGIN
RETURN GetStr (string);
END GetStrA;
(****** BlackMagic/Cat2Mod.rexx *********************************************
*
* NAME
* Cat2Mod.rexx - convert a catalog defintion file into Oberon source
*
* SYNOPSIS
* rx Cat2mod.rexx NOBLACKMAGIC=NOBM/S,
* CDFILE/A,BUILTINLANGUAGE=TONGUE,VERSION
*
* FUNCTION
* Converts a catalog definition file (#?.cd) into Oberon source as
* needed by GetCatalogString() and GetStr(). Just import the
* resulting source module in your Oberon main module, and you can
* use GetCatalogString() / GetStr() with the generated string
* constants definitions.
*
* Originally this rexx script needed Nico François' Cat2H utility,
* which converts catalog definitons into C-source headers. Starting
* from version Cat2Mod.rexx 2.0, Cat2Mod.rexx reads the catalog
* definition files directly and Cat2H employment has been discarded.
* Since Cat2Mod.rexx 2.0, the only alien ressource used by
* Cat2Mod.rexx is the (enclosed) rexxextra.library
*
* INPUTS
* NOBLACKMAGIC=NOBM/S
* - if this switch is specified, Cat2Mod.rexx generates
* a module which does _NOT_ need BlackMagic to run.
* The generated module exports equivalents to BlackMagic's
* StrIndex(), StrIndexA(), GetCatalogStr(),
* GetCatalogStrA(), GetStr() and GetStrA() functions.
*
* CDFILE/A - the catalog defintion file
*
* BUILTINLANGUAGE=TONGUE
* - the name of the language of the built-in strings.
* Defaults to 'english'. Possible values for this
* parameter are 'deutsch', 'français', etc.
*
* VERSION - the version of the catalogs belonging to the
* catalog definition file that is to be processed.
*
* RESULT
* the Oberon source module with the string constants defintions
* and the default catalog opening code - import it into your main
* module. It tries to open its appertaining catalog in the
* system's default language on startup, and assigns it to
* BlackMagic.DefaultCatalog. Moreover the generated module exports
* a function named Open<ProjectName>Catalog (language: ARRAY OF CHAR);
* which you can use to change the language. Passing an emtpy string
* ("") to it, makes it trying to (re)open the catalog in the system's
* default language.
*
* NOTES
* This rexx script and the generated Oberon source module make
* some assumptions about naming and storing conventions of
* your catalog defintion and Oberon source files:
* the destination source is written into the directory, where the
* source catalog definition file is located. Its filename is
* the same as the source file's one, plus 'Strings.mod', with
* a probable '.cd' suffix of the source file name omitted.
* The catalog is considered to be named like the file name of the
* destination module without the trailing 'Strings.mod' in lower
* case, plus the standard '.catalog' suffix.
*
* SEE ALSO
* GetCatalogString(), GetStr()
*
*****************************************************************************)
TYPE
SpritePtr = UNTRACED POINTER TO Sprite;
Sprite = ARRAY 36 OF INTEGER;
VAR
waitPointer: SpritePtr;
CONST
waitPointer1 = Sprite(
00000H, 00000U,
00400H, 007C0U,
00000H, 007C0U,
00100H, 00380U,
00000H, 007E0U,
007C0H, 01FF8U,
01FF0H, 03FECU,
03FF8H, 07FDEU,
03FF8H, 07FBEU,
07FFCH, 0FF7FU,
07EFCH, 0FFFFU,
07FFCH, 0FFFFU,
03FF8H, 07FFEU,
03FF8H, 07FFEU,
01FF0H, 03FFCU,
007C0H, 01FF8U,
00000H, 007E0U,
00000H, 00000H);
(****** BlackMagic/SetWaitPointer **********************************************
*
* NAME
* SetWaitPointer - set a window's pointer to busy state
*
* SYNOPSIS
* SetWaitPointer (win: Intuition.WindowPtr);
*
* FUNCTION
* This function sets a window's pointer to busy state without
* blocking window input or anything else. This is useful to inform
* the user that your application is busy, but you still want to react
* to the user's input activity.
* This function tries to apply the best technique available at
* runtime for this job; including Intuition V39.
*
* INPUTS
* win - the window whose pointer is to be set to busy state - may
* be NIL.
*
* SEE ALSO
* ClearWaitPointer()
*
*****************************************************************************)
PROCEDURE SetWaitPointer * (win: I.WindowPtr);
BEGIN
IF win = NIL THEN RETURN; END;
IF I.int.libNode.version >= 39 THEN
I.SetWindowPointer (win, I.waBusyPointer, I.LTRUE, u.done);
ELSE
e.Forbid();
IF waitPointer = NIL THEN
waitPointer := e.AllocVec (SIZE (waitPointer^), LONGSET{e.chip,e.public});
IF waitPointer # NIL THEN waitPointer^ := waitPointer1; END;
END;
e.Permit();
IF waitPointer # NIL THEN I.SetPointer(win, waitPointer^, 16, 16, 0, 0); END;
END;
END SetWaitPointer;
(****** BlackMagic/ClearWaitPointer ********************************************
*
* NAME
* ClearWaitPointer - release a window's pointer from busy state
*
* SYNOPSIS
* ClearWaitPointer (win: Intuition.WindowPtr);
*
* FUNCTION
* This function releases a window's pointer from its busy state
* set by SetWaitPointer(). It is generally harmless to call this
* function without a prior call to SetWaitPointer().
*
* INPUTS
* win - the window whose pointer is to be released from busy
* state - may be NIL.
*
* SEE ALSO
* SetWaitPointer()
*
*****************************************************************************)
PROCEDURE ClearWaitPointer * (win: I.WindowPtr);
BEGIN
IF win = NIL THEN RETURN; END;
IF I.int.libNode.version >= 39 THEN
I.SetWindowPointer (win, u.done);
ELSE
I.ClearPointer (win)
END;
END ClearWaitPointer;
(****** BlackMagic/LockWindow **************************************************
*
* NAME
* LockWindow - set a window to busy state - calls may be nested
*
* SYNOPSIS
* LockWindow (win: Intuition.WindowPtr;
* wl : WinLockPtr ): WinLockPtr;
*
* FUNCTION
* This function makes a window block all input and makes it
* indicate that it is in busy state by setting its busy pointer.
* This function tries to apply the best technique available at
* runtime for this job; including Intuition V39. You may nest
* calls to this function.
*
*
* INPUTS
* win - the window to be locked - may be NIL.
* wl - a valid WinLockPtr from former calls to LockWindow()
* for the same <win> window or NIL.
*
*
*
* RESULT
* a valid WinLockPtr that is used by UnlockWindow() to release
* the Window from its busy state, or NIL. (You should usually
* not check the return value for NIL since UnlockWindow()
* handles a NIL input correctly.
*
* SEE ALSO
* UnlockWindow()
*
*****************************************************************************)
TYPE
WinLockPtr * = UNTRACED POINTER TO WinLock;
WinLock = STRUCT (req: I.Requester)
nestCount : LONGINT;
END;
PROCEDURE LockWindow * (win: I.WindowPtr; wl: WinLockPtr): WinLockPtr;
BEGIN
IF wl # NIL THEN
IF wl.req.rWindow = win THEN INC (wl.nestCount); END;
ELSE
IF win=NIL THEN RETURN NIL; END;
y.ALLOCATE (wl);
IF wl=NIL THEN RETURN NIL; END;
IF ~I.Request (wl, win) THEN DISPOSE (wl); RETURN NIL; END;
END;
SetWaitPointer (win);
RETURN wl;
END LockWindow;
(****** BlackMagic/UnlockWindow ************************************************
*
* NAME
* UnlockWindow - release a window from its busy state
*
* SYNOPSIS
* UnlockWindow (VAR wl: WinLockPtr);
*
* FUNCTION
* This function releases a window that was previously set to busy
* state by LockWindow() from its busy state and frees the passed
* wl WinLockPtr if the nest count is zero, otherwise the nest count
* is solely decremented by 1. For a NIL wl input parameter, it does
* nothing at all.
*
* INPUTS
* wl - the WinLockPtr retured by LockWindow(). May be NIL.
*
* RESULTS
* The VAR wl is cleared if the window has really been unlocked.
*
* SEE ALSO
* LockWindow()
*
*****************************************************************************)
PROCEDURE UnlockWindow* (VAR wl: WinLockPtr);
VAR
win: I.WindowPtr;
BEGIN
IF wl = NIL THEN RETURN END;
IF wl.nestCount > 0 THEN
DEC (wl.nestCount);
ELSE
win := wl.req.rWindow;
I.EndRequest (wl, win);
ClearWaitPointer (win);
DISPOSE (wl);
END;
END UnlockWindow;
(****** BlackMagic/gtItemAddr *************************************************
*
* NAME
* gtItemAddr - return the MenuItem from a GadTools.NewMenu.userData
*
* SYNOPSIS
* gtItemAddr (menu: Intuition.MenuPtr;
* data: Exec.APTR ): Intuition.MenuItemPtr;
*
* FUNCTION
* This function returns the menu item that was created by GadTools
* from a specific GadTools.NewMenu entry. This is done, employing
* the GadTools.NewMenu.userData field, which has to be set to a
* unique value if you want to find the menu item using this function.
* Both, items and sub items are found.
*
* INPUTS
* menu - the Intuition menu that was previously created by
* GadTools.CreateMenusA() - may be NIL.
* data - the unique userData entry of a GadTools.NewMenu array
* element of either GadTools.item or GadTools.sub type
*
* RESULT
* a valid Intuition.MenuItemPtr or NIL if the item was not found in
* in the menu chain.
*
* SEE ALSO
* gtMenuAddr()
*
*****************************************************************************)
PROCEDURE gtItemAddr * (menu: I.MenuPtr;
data: e.APTR ): I.MenuItemPtr;
VAR
i,s: I.MenuItemPtr;
BEGIN
WHILE menu # NIL DO
i := menu.firstItem;
WHILE i # NIL DO
IF gt.MenuItemUserData (i) = data THEN RETURN i; END;
s := i.subItem;
WHILE s # NIL DO
IF gt.MenuItemUserData (s) = data THEN RETURN s; END;
s := s.nextItem;
END;
i := i.nextItem;
END;
menu := menu.nextMenu;
END;
RETURN NIL;
END gtItemAddr;
(****** BlackMagic/gtMenuAddr *************************************************
*
* NAME
* gtMenuAddr - return the Menu from a GadTools.NewMenu.userData
*
* SYNOPSIS
* gtMenuAddr (firstmenu: Intuition.MenuPtr;
* data : Exec.APTR ): Intuition.MenuPtr;
*
* FUNCTION
* This function returns the menu that was created by GadTools
* from a specific GadTools.NewMenu entry. This is done, employing
* the GadTools.NewMenu.userData field, which has to be set to a
* unique value if you want to find the menu using this function.
*
* INPUTS
* firstmenu- the Intuition menu that was previously created by
* GadTools.CreateMenusA() - may be NIL.
* data - the unique userData entry of a GadTools.NewMenu array
* element of GadTools.title type
*
* RESULT
* a valid Intuition.MenuPtr or NIL if the menu was not found in
* in the menu chain.
*
* SEE ALSO
* gtItemAddr()
*
*****************************************************************************)
PROCEDURE gtMenuAddr * (firstmenu: I.MenuPtr;
data : e.APTR ): I.MenuPtr;
BEGIN
WHILE firstmenu # NIL DO
IF gt.MenuUserData (firstmenu) = data THEN RETURN firstmenu; END;
firstmenu := firstmenu.nextMenu;
END;
RETURN NIL;
END gtMenuAddr;
(****** BlackMagic/GadKey *****************************************************
*
* NAME
* GadKey / GadKeyA - return the key shortcut for a string.
*
* SYNOPSIS
* GadKey (gadstr: ARRAY OF CHAR): CHAR;
*
* GadKeyA (gadstr: Exec.APTR): CHAR;
*
* FUNCTION
* These functions return the key shortcut character from a string.
* They search for the underscrore character in the string, and
* if they find one, return the following charcter as the key
* shortcut. Otherwise a nul character is returned. For GadKeyA(),
* a NIL pointer may be passed. In that case, the result will be
* the nul character as well. These functions use the
* BlackMagic.UnderScore variable for identifiying the underscore
* character. By default, this variable is initialized to '_'.
* However, you may change that to any character you want.
*
*
* INPUTS
* gadstr - the string to be searched for an underscore sequence.
* Either as an ARRAY OF CHAR for GadKey() or as an
* Exec.APTR for GadKeyA().
*
* RESULT
* the key shortcut character or the nul character, if no shortcut
* was found.
*
*****************************************************************************)
VAR
UnderScore * : CHAR;
PROCEDURE GadKey * (gadstr: ARRAY OF CHAR): CHAR;
VAR
j : LONGINT;
(* $CopyArrays- *)
BEGIN
j := 0;
WHILE gadstr[j] # '\000' DO
IF gadstr[j] = UnderScore THEN RETURN gadstr[j+1]; END;
INC (j);
END;
RETURN '\000';
END GadKey;
PROCEDURE GadKeyA * (gadstr: e.APTR): CHAR;
VAR
str: LongStrPtr;
BEGIN
IF gadstr = NIL THEN RETURN CHR (0); END;
str := gadstr;
RETURN GadKey (str^);
END GadKeyA;
(****** BlackMagic/ClearMem ***************************************************
*
* NAME
* ClearMem -- clear memory
* ClearMemAPTR -- " "
*
* SYNOPSIS
* ClearMem (mem: ARRAY OF SYSTEM.BYTE; n: LONGINT);
*
* ClearMemAPTR (mem: Exec.APTR; n: LONGINT);
*
* FUNCTION
* These functions clear n bytes of memory starting at
* address mem, or in case of ClearMem(), it clears the whole
* structure represented by the mem BYTE-ARRAY if -1 is passed
* for the n parameter.
*
* INPUTS
* mem - the starting position for the clearing operation
* as an ARRAY OF SYSTEM.BYTE for ClearMem() or as an
* Exec.APTR for ClearMemAPTR()
* n - the number of bytes to be cleared. In case of
* ClearMem(), this parameter may be -1, in which case
* the whole structure represented by the BYTE-ARRAY
* is cleared.
*
* SEE ALSO
* Exec/CopyMem(), Exec.CopyMemAPTR()
*
*****************************************************************************)
PROCEDURE ClearMem * (mem: ARRAY OF y.BYTE; n: LONGINT);
(* $CopyArrays- *)
BEGIN
IF n=-1 THEN n := LEN (mem); END;
IF n < 1 THEN RETURN; END;
WHILE n > 0 DO DEC (n); mem[n] := 0; END;
END ClearMem;
PROCEDURE ClearMemAPTR * (mem: e.APTR; n: LONGINT);
VAR
m: UNTRACED POINTER TO ARRAY 1 OF y.BYTE;
BEGIN
m := mem;
IF n < 1 THEN RETURN; END;
ClearMem (m^, n);
END ClearMemAPTR;
(****** BlackMagic/Max2 *****************************************************
*
* NAME
* Max2 - return the maximum of two numbers
* Min2 - return the minimum of two numbers
*
* SYNOPSIS
* Max2 (x, y: LONGINT): LONGINT;
*
* Min2 (x, y: LONGINT): LONGINT;
*
* FUNCTION
* These functions just return the larger / smaller one of two
* supplied numbers. As this job is needed very often, and
* since many programmers are lazybones;-) who use roundabout
* programming instead of implementing these functions, I decided
* to supply these trivial functions.
*
* INPUTS
* x,y - two numbers
*
* RESULT
* the maximum / minimum of the supplied numbers
*
* NOTES
* Max3() etc. can be emulated by code like 'Max2 (Max2 (x, y), z)',
* of course.
*
*****************************************************************************)
PROCEDURE Max2 * (x, y: LONGINT): LONGINT;
BEGIN
IF x > y THEN RETURN x; ELSE RETURN y; END;
END Max2;
PROCEDURE Min2 * (x, y: LONGINT): LONGINT;
BEGIN
IF x < y THEN RETURN x; ELSE RETURN y; END;
END Min2;
(****** BlackMagic/Strlastnicmp **********************************************
*
* NAME
* Strlastnicmp - length-limited case-insensitive backward str compare
*
* SYNOPSIS
* Strlastnicmp (s1, s2: ARRAY OF CHAR, n: LONGINT): BOOLEAN;
*
* FUNCTION
* This function provides the much needed but rarely found
* complement for the Utility.Strnicmp() function. It compares
* two strings starting from the last character. It returns
* TRUE if the last n characters match, or if both strings
* are shorter than n characters and match exactly.
* The comparisons are performed case-insensitively using the
* Utility.library Stricmp() function.
*
* INPUTS
* s1,s2 - the strings to be compared
* n - the maximum number of characters that may be taken
* into account
*
* RESULT
* TRUE for equality, FALSE otherwise
*
* SEE ALSO
* Strlastncmp(), Utility/Strnicmp()
*
*****************************************************************************)
PROCEDURE Strlastnicmp * (s1, s2: ARRAY OF CHAR; n: LONGINT): BOOLEAN;
VAR
l1, l2: LONGINT;
(* $CopyArrays- *)
BEGIN
l1 := st.Length (s1); l2 := st.Length (s2);
IF (l1 < n) OR (l2 < n) THEN RETURN u.Stricmp (s1, s2) = 0; END;
RETURN u.Stricmp (StrIndex (s1, l1-n)^, StrIndex (s2, l2-n)^) = 0;
END Strlastnicmp;
(****** BlackMagic/Strlastncmp **********************************************
*
* NAME
* Strlastncmp - length-limited case-sensitive backward string compare
*
* SYNOPSIS
* Strlastncmp (s1, s2: ARRAY OF CHAR, n: LONGINT): BOOLEAN;
*
* FUNCTION
* Same as Strlastnicmp(), except that comparisons are made
* case-sensitively.
*
* SEE ALSO
* Strlastnicmp()
*
*****************************************************************************)
PROCEDURE Strlastncmp * (s1, s2: ARRAY OF CHAR; n: LONGINT): BOOLEAN;
VAR
l1, l2: LONGINT;
(* $CopyArrays- *)
BEGIN
l1 := st.Length (s1); l2 := st.Length (s2);
IF (l1 < n) OR (l2 < n) THEN RETURN s1=s2; END;
RETURN StrIndex (s1, l1-n)^ = StrIndex (s2, l2-n)^;
END Strlastncmp;
(****** BlackMagic/ScrVPExtra ********************************************
*
* NAME
* ScrVPExtra - return a screen's Graphics.ViewPortExtra structure
*
* SYNOPSIS
* ScrVPExtra (scr: Intuition.ScreenPtr): Graphics.ViewPortExtraPtr;
*
* FUNCTION
* This function returns the ViewPortExtra structure associated
* with a screen's ViewPort. The ViewPortExtra structure holds the
* Screen's DisplayClip information in its vpe.displayClip entry.
*
* INPUTS
* scr - the screen whose VPE you want to get - may be NIL
*
* RESULT
* a pointer to the screen's ViewPortExtra structure or NIL for failure
*
*****************************************************************************)
CONST
vTags = u.Tags2 (g.vTagViewPortExtraGet, NIL, g.vTagEndCM, NIL);
PROCEDURE ScrVPExtra * (scr: I.ScreenPtr): g.ViewPortExtraPtr;
VAR
VTags: u.Tags2;
VPE : g.ViewPortExtraPtr;
BEGIN
IF scr = NIL THEN RETURN NIL; END;
VTags := vTags;
IF g.VideoControlA (scr.viewPort.colorMap, VTags) THEN RETURN NIL; END;
IF VTags[0].tag # g.vTagViewPortExtraSet THEN RETURN NIL; END;
RETURN VTags[0].data;
END ScrVPExtra;
(****** BlackMagic/VisibleOfScreen ********************************************
*
* NAME
* VisibleOfScreen - return the visible region of a screen
*
* SYNOPSIS
* VisibleOfScreen (scr : Intuition.ScreenPtr;
* VAR visible: Graphics.Rectangle ): BOOLEAN;
*
* FUNCTION
* This function fills in the supplied Graphics.Rectangle structure
* with the bounds of the region of the provided Screen that is
* currently visible in the Screen's DisplayClip. It handles
* all possible cases of DisplayClip<->Screen dimensions.
*
* INPUTS
* scr - the screen to investigate - may be NIL
* visible - the Graphics.Rectangle strucute that is to be filled
* with the bounds.
*
* RESULT
* TRUE if everything if the supplied Rectangle structure has been
* filled with the bounds, FALSE if the necessary information couldn't
* be obtained for some reason. Note that the supplied Rectangle
* structure's coordinates are all filled with 0 if you pass
* a NIL scr Intuition.ScreenPtr, or with the bounds of the whole
* screen if the function fails due to another reason.
*
*****************************************************************************)
PROCEDURE VisibleOfScreen * (scr: I.ScreenPtr; VAR visible: g.Rectangle): BOOLEAN;
VAR
VPE : g.ViewPortExtraPtr;
BEGIN
visible.minX := 0; visible.minY := 0; visible.maxX := 0; visible.maxY := 0;
IF scr = NIL THEN RETURN FALSE; END;
visible.maxX := scr.width-1; visible.maxY := scr.height-1;
VPE := ScrVPExtra (scr);
IF VPE = NIL THEN RETURN FALSE; END;
visible.minX := SHORT (Max2 (0, -scr.leftEdge + VPE.displayClip.minX));
visible.minY := SHORT (Max2 (0, -scr.topEdge + VPE.displayClip.minY));
visible.maxX := SHORT (Min2 (scr.width - 1, -scr.leftEdge + VPE.displayClip.maxX));
visible.maxY := SHORT (Min2 (scr.height - 1, -scr.topEdge + VPE.displayClip.maxY));
RETURN TRUE;
END VisibleOfScreen;
(****** BlackMagic/SPrintf ****************************************************
*
* NAME
* SPrintf ¹ -- varargs sprintf output formatting using Exec.RawDoFmt
* SPrintF ¹ -- varargs sprintf output formatting without result code
* VSPrintf ¹ -- vector sprintf output formatting using Exec.RawDoFmt
* VSPrintF ¹ -- vector sprintf output formatting without result code
*
* SYNOPSIS
* BlackMagicVA.SPrintf (buffer: ARRAY OF CHAR;
* format: ARRAY OF CHAR;
* args..: Exec.APTR ): LONGINT;
*
* BlackMagicVA.SPrintF (buffer: ARRAY OF CHAR;
* format: ARRAY OF CHAR;
* args..: Exec.APTR );
*
* BlackMagicVA.VSPrintf (buffer: ARRAY OF CHAR;
* format: ARRAY OF CHAR;
* args : Exec.APTR ): LONGINT;
*
* BlackMagicVA.VSPrintF (buffer: ARRAY OF CHAR;
* format: ARRAY OF CHAR;
* args : Exec.APTR );
*
* FUNCTION
* These functions are full featured implementations of sprintf()/
* vsprintf(), supporting also the nifty varargs paramters provided
* by Amiga-Oberon for library calls. Due to the fact that these
* functions are implemented as library functions, you may pass NIL
* for the buffer ARRAY OF CHAR parameter which makes this function
* doing nothing but returning the length WITHOUT the trailing null
* byte of the generated output.
*
* INPUTS
* buffer - the buffer into which the output is written to or
* NIL
* format - the format string with the formatting directives.
* For a detailed description of all possible directives
* have a look at Exec/RawDoFmt(). *ALL* directives
* except of %s/%b require a leading 'l' right before the
* type character, e.g. '%ld', '%08lx' or '%lc' instead of
* '%d', '%08x' or '%c'. This is true for Dos/Printf() and
* similar functions as well.
* args - the arguments to be included into the generated
* string according to the directives specified in the
* format string. Either as varargs for SPrintf()/SPrintF()
* or as a pointer to the arguemnts for VSPrintf()/
* VSPrintF()
*
* RESULT
* LONGINT - the length of the generated output WITHOUT the trailing
* null byte, which is actually written into the buffer
* as the last byte.
*
* NOTES
* ¹) All these functions are placed in the BlackMagicVA module!
*
* SEE ALSO
* DynAppendFmt(), VDynAppendFmt(), Exec/RawDoFmt(), Dos/VPrintf()
*
*****************************************************************************)
(* refer to BlackMagicVA for sprintf() - code *)
(****** BlackMagic/DynAppendFmt ***********************************************
*
* NAME
* DynAppendFmt/DSPrintf ¹ -- append sprintf str to a dynstr (varargs)
* VDynAppendFmt/VDSPrintf -- append sprintf str to dynstr (vector args)
*
* SYNOPSIS
* BlackMagicVA.DynAppendFmt
* BlackMagicVA.DSPrintf (VAR dstr: DynStrPtr;
* format : ARRAY OF CHAR;
* args.. : Exec.APTR ): BOOLEAN;
*
* VDynAppendFmt
* VDSPrintf (VAR dstr: DynStrPtr;
* format : ARRAY OF CHAR;
* args : Exec.APTR ): BOOLEAN;
*
* FUNCTION
* These functions are similar to SPrintF()/VSPrintF(), except that
* they act on dynamic strings rather than on simple strings, and
* append the resulting string to the dynamic string rather than
* overwriting it. Note that the valid string bounds will be _never_
* violated.
*
* INPUTS
* dstr - the handle for the dynamic string, to which the
* resulting string is appended to. May be NIL.
* format - the format string with the formatting directives.
* For a detailed description of all possible directives
* have a look at Exec/RawDoFmt(). *ALL* directives
* except of %s/%b require a leading 'l' right before the
* type character, e.g. '%ld', '%08lx' or '%lc' instead of
* '%d', '%08x' or '%c'. This is true for Dos/Printf() and
* similar functions as well.
* args - the arguments to be included into the generated
* string according to the directives specified in the
* format string. Either as varargs for DynAppendFmt()/
* DSPrintf() or as a pointer to the arguemnts for
* VDynAppendFmt()/VDSPrintf().
*
* RESULT
* BOOLEAN - TRUE if the resulting string was successfully appended to
* the dynamic string, FALSE otherwise. For FALSE, the
* contents of the dynamic string, not necessarily its
* handle, are left unchanged.
*
* NOTES
* ¹) The functions with var args parameters are placed in the
* BlackMagicVA module! The other functions are exported by both,
* BlackMagic and BlackMagicVA.
*
* SEE ALSO
* SPrintF(), VSPrintF(), Exec/RawDoFmt(), Dos/VPrintf()
*
*****************************************************************************)
TYPE
FmtDataPtr = UNTRACED POINTER TO FmtData;
FmtData = STRUCT
a5 : e.APTR;
dstr : UNTRACED POINTER TO DynStrPtr;
success : BOOLEAN;
END;
PROCEDURE FmtFunc1 (VAR data: FmtData; ch: CHAR);
VAR
chrs: ARRAY 2 OF CHAR;
BEGIN
IF ~data.success THEN RETURN; END;
chrs[0] := ch; chrs[1] := '\000';
data.success := DynAppend (data.dstr^, chrs);
END FmtFunc1;
PROCEDURE FmtFunc (VAR data{11}: FmtData; ch{0}: CHAR; SaveA0Kludge{8}: LONGINT);
VAR
c: CHAR;
(* Amiga-Oberon3.0 does not save A0 with SaveAllRegs+ - The SaveA0Kludge parameter solves that for you *)
(* 7-Jul-93: Maybe that's not true - I discovered that ADis1.11 - a freeware symbolic *)
(* reassembler I use - mismatches some MOVEM reglists! *)
(* $StackChk- $SaveAllRegs+ *)
BEGIN
c := ch; (* d0/d1 volatile! *)
y.SETREG (13, data.a5);
FmtFunc1 (data, c);
END FmtFunc;
(* $StackChk= *)
PROCEDURE DynAppendFmtInternal1 (dstr : UNTRACED POINTER TO DynStrPtr;
format: LongStrPtr;
args : e.APTR ): BOOLEAN;
VAR
data: FmtData;
origLen : LONGINT;
BEGIN
data.a5 := y.REG (13);
data.dstr := dstr; data.success := TRUE;
origLen := DynStrLen (dstr^);
e.OldRawDoFmt (format^, args, y.VAL (e.PROC, FmtFunc), y.ADR (data));
IF ~data.success THEN IF dstr^ # NIL THEN dstr^[origLen] := '\000'; END; END;
RETURN data.success;
END DynAppendFmtInternal1;
PROCEDURE VDynAppendFmt * (VAR dstr: DynStrPtr;
format : ARRAY OF CHAR;
args : e.APTR ): BOOLEAN;
(* $CopyArrays- *)
BEGIN
RETURN DynAppendFmtInternal1 (y.ADR (dstr), y.ADR (format[0]), args);
END VDynAppendFmt;
PROCEDURE VDSPrintf * (VAR dstr: DynStrPtr;
format : ARRAY OF CHAR;
args : e.APTR ): BOOLEAN;
(* $CopyArrays- *)
BEGIN
RETURN DynAppendFmtInternal1 (y.ADR (dstr), y.ADR (format[0]), args);
END VDSPrintf;
(****** BlackMagic/DynFmtLocale ***********************************************
*
* NAME
* DynFmtLocale ¹ -- do locale/FormatString() with a dynstr (varargs)
* VDynFmtLocale -- do locale/FormatString() with dynstr (vector args)
*
* SYNOPSIS
* BlackMagicVA.DynFmtLocale (VAR dstr: DynStrPtr;
* locale : Locale.LocalePtr;
* format : ARRAY OF CHAR;
* args.. : Exec.APTR ): BOOLEAN;
*
* VDynFmtLocale (VAR dstr: DynStrPtr;
* locale : Locale.LocalePtr;
* format : ARRAY OF CHAR;
* args : Exec.APTR ): BOOLEAN;
*
* FUNCTION
* These functions offer a dynamic string interface to locale.library's
* FormatString() function, which is a RawDoFmt() / xxxprintf() - like
* string formatting function with some additional support for
* localization. Both functions append the resulting string to the
* dynamic string represented by the dstr handle. The valid string
* bounds of dstr will never be violated, it rather returns failure
* if not enough string space could be allocated. If Locale.base is
* NIL, these functions perform a fallback to (V)DynAppendFmt().
*
* INPUTS
* dstr - the handle for the dynamic string, to which the
* resulting string is appended to. May be NIL.
* locale - the locale structure to use for formatting. May be NIL,
* in which case the system's default locale is used.
* format - the format string with the formatting directives.
* For a detailed description of all possible directives
* have a look at Locale/FormatString(). *ALL* directives
* except of %s/%b require a leading 'l' right before the
* type character, e.g. '%ld', '%08lx' or '%lc' instead of
* '%d', '%08x' or '%c'. This is true for Dos/Printf() and
* similar functions as well.
* args - the arguments to be included into the generated
* string according to the directives specified in the
* format string. Either as varargs for DynFmtLocale()
* or as a pointer to the arguemnts for VDynFmtLocale().
*
* RESULT
* BOOLEAN - TRUE if the resulting string was successfully appended
* to the dynamic string, FALSE otherwise (Probably failed
* memory allocation for the dynamic string or a NIL-
* Locale.base). For FALSE, the contents of the dynamic
* string, not necessarily its handle, are left unchanged.
*
* NOTES
* ¹) The functions with var args parameters are placed in the
* BlackMagicVA module! The other functions are exported by both,
* BlackMagic and BlackMagicVA.
*
* SEE ALSO
* DynAppendFmt(), Locale/FormatString(), FLPrintf()
*
*****************************************************************************)
PROCEDURE FmtLocaleHookFunc1 (VAR data: FmtData; ch: LONGINT);
VAR
c2 : ARRAY 2 OF CHAR;
BEGIN
IF ~data.success THEN RETURN; END;
c2[0] := CHR (ch); c2[1] := '\000';
data.success := DynAppend (data.dstr^, c2);
END FmtLocaleHookFunc1;
PROCEDURE FmtLocaleHookFunc (hk{8}: u.HookPtr; ch{9}: LONGINT);
VAR
data: FmtDataPtr;
(* $StackChk- $SaveRegs+ *)
BEGIN
data := hk.data;
y.SETREG (13, data.a5);
FmtLocaleHookFunc1 (data^, ch);
END FmtLocaleHookFunc;
(* $StackChk= *)
TYPE HookEntryProc = PROCEDURE(hook{8} : u.HookPtr;
object{10}: e.APTR;
message{9}: e.APTR): LONGINT;
PROCEDURE DynFmtLocaleInternal1 (dstr : UNTRACED POINTER TO DynStrPtr;
locale: loc.LocalePtr;
format: LongStrPtr;
args : e.APTR ): BOOLEAN;
VAR
hk : u.Hook;
data : FmtData;
origLen : LONGINT;
locale1 : loc.LocalePtr;
BEGIN
IF ~DynExpand (dstr^, 0) THEN RETURN FALSE; END;
IF format = NIL THEN RETURN TRUE; END;
IF loc.base = NIL THEN
RETURN VDSPrintf (dstr^, format^, args);
END;
IF locale = NIL THEN locale1 := loc.OpenLocale (NIL); ELSE locale1 := locale; END;
hk.entry := y.VAL (HookEntryProc, FmtLocaleHookFunc);
data.a5 := y.REG (13); hk.subEntry := NIL; hk.data := y.ADR (data);
data.dstr := dstr; data.success := TRUE;
origLen := DynStrLen (dstr^);
y.SETREG (0, loc.FormatString (locale1, format^, args, y.ADR (hk)));
IF ~data.success THEN IF dstr^ # NIL THEN dstr^[origLen] := '\000'; END; END;
IF locale = NIL THEN loc.CloseLocale (locale1); END;
RETURN data.success;
END DynFmtLocaleInternal1;
PROCEDURE VDynFmtLocale * (VAR dstr: DynStrPtr;
locale : loc.LocalePtr;
format : ARRAY OF CHAR;
args : e.APTR ): BOOLEAN;
(* $CopyArrays- *)
BEGIN
RETURN DynFmtLocaleInternal1 (y.ADR (dstr), locale, y.ADR (format[0]), args);
END VDynFmtLocale;
(****** BlackMagic/FLPrintf ***************************************************
*
* NAME
* FLPrintf ¹ -- equivalent to Dos/FPrintf() with localization support
* FLPrintF ¹ -- equivalent to FLPrintf without return code
* VFLPrintF -- equivalent to FLPrintf with vector args
*
* SYNOPSIS
* BlackMagicVA.FLPrintf (fh : d.FileHandlePtr;
* locale: loc.LocalePtr;
* format: ARRAY OF CHAR;
* args..: e.APTR ): BOOLEAN;
*
* BlackMagicVA.FLPrintF (fh : d.FileHandlePtr;
* locale: loc.LocalePtr;
* format: ARRAY OF CHAR;
* args..: e.APTR );
*
* VFLPrintf (fh : d.FileHandlePtr;
* locale: loc.LocalePtr;
* format: ARRAY OF CHAR;
* args : e.APTR ): BOOLEAN;
*
* FUNCTION
* These functions use VDynFmtLocale() to build a string according
* to the provided arguments and if this succeeded, they write it
* to the fh file.
*
* INPUTS
* fh - the file to write the resulting string to.
* May be NIL, in which case stdout is used.
*
* Other: - see DynFmtLocale()
*
* RESULT
* BOOLEAN - TRUE if the resulting string was successfully generated
* and written, FALSE otherwise.
*
* NOTES
* ¹) The functions with var args parameters are placed in the
* BlackMagicVA module! The other functions are exported by both,
* BlackMagic and BlackMagicVA.
*
* SEE ALSO
* DynAppendFmt(), Locale/FormatString(), DynFmtLocale()
*
*****************************************************************************)
PROCEDURE FLPrintfInternal1 (fh : d.FileHandlePtr;
locale: loc.LocalePtr;
format: LongStrPtr;
args : e.APTR ): BOOLEAN;
VAR
ds: DynStrPtr;
r : BOOLEAN;
BEGIN
ds := NIL;
IF fh = NIL THEN fh := d.Output(); END;
IF format = NIL THEN RETURN FALSE; END;
r := VDynFmtLocale (ds, locale, format^, args);
IF r THEN
IF d.FPrintf (fh, "%s", StrIndex (ds^, 0)) # DynStrLen (ds) THEN r := FALSE; END;
END;
DISPOSE (ds);
RETURN r;
END FLPrintfInternal1;
PROCEDURE VFLPrintf * (fh : d.FileHandlePtr;
locale : loc.LocalePtr;
format : ARRAY OF CHAR;
args : e.APTR ): BOOLEAN;
(* $CopyArrays- *)
BEGIN
RETURN FLPrintfInternal1 (fh, locale, y.ADR (format[0]), args);
END VFLPrintf;
(****** BlackMagic/SimpleRequest **********************************************
*
* NAME
* SimpleRequest ¹ -- Easy altern. to Intuition.EasyRequest() (varargs)
* SimpleRequestArgs -- Easy alternative to Intuition.EasyRequestArgs()
*
* SYNOPSIS
* BlackMagicVA.SimpleRequest (win : Intuition.WindowPtr;
* flags : LONGSET;
* title : ARRAY OF CHAR;
* txtfmt : ARRAY OF CHAR;
* gadfmt : ARRAY OF CHAR;
* args.. : Exec.APTR ): LONGINT;
*
* SimpleRequestArgs (win : Intuition.WindowPtr;
* flags : LONGSET;
* title : ARRAY OF CHAR;
* txtfmt : ARRAY OF CHAR;
* gadfmt : ARRAY OF CHAR;
* args : Exec.APTR ): LONGINT;
*
* FUNCTION
* Simplifies invokation of Intuition.EasyRequestArgs() to the
* Oberon user. You may specify most of Intuition.EasyRequestArgs()'
* possible parameters (window, easyStruct.title, easyStruct.txtfmt,
* easyStruct.gadfmt and args (as varargs for SimpleRequest() or as
* vector args for SimpleRequestArgs()). Furthermore, the possibility
* of automatically locking the parent window is available.
*
* INPUTS
* win - the requester's 'parent window.' Corresponds to
* EasyRequestArgs()' window parameter.
* flags - currently two flags are defined for this parameter:
* - lockWindow: if you specify it, and you pass a
* non-NIL win parameter, that window is locked and
* set to busy state while the requester is displayed.
* - ignoreTitle: if this flag is set, the title parameter
* is ignored, behaviour is the same as described for
* a NIL-title parameter.
* title - the title text for the requester. For the functions
* exported from BlackMagicVA, this parameter may be NIL
* in which case the parent window's title is used, or
* if no parent window is supplied, the system's default
* title. Corresponds to EasyRequestArgs()'
* easyStruct.title parameter.
* txtfmt - the sprintf()-like text format string. Corresponds to
* EasyRequestArgs()' easyStruct.textFormat parameter.
* gadfmt - the sprintf()-like gadgets format string. Corresponds
* to EasyRequestArgs()' easyStruct.gadgetFormat parameter.
* The '|' character is used as the gadget separator
* character.
* args - the arguments for the txtfmt and gadfmt formatting
* directives. Corresponds to EasyRequestArgs()' parameter
* of the same name. Either as varargs for SimpleRequest()
* or as vector args for SimpleRequestArgs().
*
* RESULT
* 0 for the rightmost gadget, otherwise the triggered gadget's
* ordinal number from the left, starting at one.
*
* NOTES
* ¹) The functions with var args parameters are placed in the
* BlackMagicVA module! The other functions are exported by both,
* BlackMagic and BlackMagicVA.
*
* SEE ALSO
* Intuition/EasyRequestArgs()
*
*****************************************************************************)
CONST
lockWindow * = 0;
ignoreTitle * = 1;
simpleEasyStruct = I.EasyStruct (
SIZE (I.EasyStruct), LONGSET{},
NIL, NIL, NIL);
PROCEDURE SimpleRequestInternal1 (win : I.WindowPtr;
flags : LONGSET;
title : e.APTR;
txtfmt: e.APTR;
gadfmt: e.APTR;
args : e.APTR ): LONGINT;
VAR
es: I.EasyStruct;
r : LONGINT;
wl: WinLockPtr;
BEGIN
wl := NIL;
IF ignoreTitle IN flags THEN title := NIL; END;
es := simpleEasyStruct;
es.textFormat := txtfmt;
es.gadgetFormat := gadfmt;
es.title := title;
IF lockWindow IN flags THEN wl := LockWindow (win, wl); END;
r := I.EasyRequestArgs (win, y.ADR (es), NIL, args);
UnlockWindow (wl);
RETURN r;
END SimpleRequestInternal1;
PROCEDURE SimpleRequestArgs * (win : I.WindowPtr;
flags : LONGSET;
title : ARRAY OF CHAR;
txtfmt: ARRAY OF CHAR;
gadfmt: ARRAY OF CHAR;
args : e.APTR ): LONGINT;
(* $CopyArrays- *)
BEGIN
RETURN SimpleRequestInternal1 (win, flags, y.ADR (title[0]),
y.ADR (txtfmt[0]), y.ADR (gadfmt[0]), args);
END SimpleRequestArgs;
(****** BlackMagic/GetTTYScreen ***********************************************
*
* NAME
* GetTTYScreen -- returns the screen of a console's window
*
* SYNOPSIS
* GetTTYScreen (tty: Dos.FileHandlePtr): Intuition.ScreenPtr;
*
* FUNCTION
* GetTTYScreen returns a valid Intuition.ScreenPtr to the
* screen, the passed console has a window opened on. The ScreenPtr
* is guaranteed to be valid on the machine this function is invoked
* from. If the passed FileHandle does not refer to a console with a
* screen on the invoking machine, NIL is returned.
*
* INPUTS
* tty - A valid FileHandle, may be NIL.
*
* RESULT
* A valid Intuition.ScreenPtr of fhe invoking machine or NIL.
*
*****************************************************************************)
PROCEDURE GetTTYScreen * (tty: d.FileHandlePtr): I.ScreenPtr;
VAR
pr : e.MsgPortPtr;
w : I.WindowPtr;
id : d.InfoDataPtr;
BEGIN
w := NIL;
IF tty = NIL THEN RETURN NIL; END;
IF ~d.IsInteractive (tty) THEN RETURN NIL; END;
pr := tty.type;
IF PtrToInt (pr) <= 0 THEN RETURN NIL; END;
id := e.AllocVec (SIZE (id^), LONGSET {e.memClear, e.public});
IF id = NIL THEN RETURN NIL; END;
IF d.DoPkt1 (pr, d.diskInfo, BPtrVal (id)) = d.DOSTRUE THEN
w := y.VAL (I.WindowPtr, id.volumeNode);
END;
e.FreeVec (id);
IF w # NIL THEN RETURN w.wScreen; END;
RETURN NIL;
END GetTTYScreen;
(****** BlackMagic/SetDynamicExtra ********************************************
*
* NAME
* SetDynamicExtra -- set BlackMagic's DynamicExtra var
*
* SYNOPSIS
* SetDynamicExtra (extra: LONGINT);
*
* FUNCTION
* This functions allows you to set BlackMagic's DynamicExtra (which is
* exported for reading). DynamicExtra specifies the extra 'units'
* BlackMagic should allocate whenever (re-)allocating Dynamic Strings
* or Dynamic ToolType arrays. The default for DynamicExtra is currently
* sixty-four. However, this may well change in the future.
*
* INPUTS
* extra - the new DynamicExtra value. Negative values are ignored.
*
* RESULT
* DynamicExtra will hold the specified positive (>= 0) extra value.
*
* SEE ALSO
* DynAppend(), DynAppendTT()
*
*****************************************************************************)
PROCEDURE SetDynamicExtra * (extra: LONGINT);
BEGIN
IF extra >= 0 THEN DynamicExtra := extra; END;
END SetDynamicExtra;
(****** BlackMagic/MemReqs ****************************************************
*
* NOTES
* In this module's startup code, the OberonLib.MemReqs variable is
* ensured to include the flags Exec.memClear _and_ Exec.public. This
* effect is documented, so you can use NEW(), SYSTEM.ALLOCATE(),
* OberonLib.New() and OberonLib.Allocate() for allocating all system
* structures (only with _untraced_ pointers, of course) unless they are
* in use beyond your program's termination. Note that it is of vital
* importance for future compatability and things like virtual memory
* management to have the Exec.public flag set when allocating several
* system structures like MsgPorts, etc. In the current OberonLib
* startup, the Exec.public flag is not set in OberonLib.MemReqs.
* However, if you allocate vast amounts of data records that are
* private to your application, it is recommended to clear the
* Exec.public flag for these allocations with
* 'EXCL (OberonLib.MemReqs, Exec.public);' because otherwise possible
* virtual memory ressources would be disabled from being used by your
* program. 'Manual' inclusion of Exec.public can be achieved by
* 'INCL (OberonLib.MemReqs, Exec.public);'
*
* Finally, it must be stated, that you can only be sure that the
* Exec.memClear & Exec.public flags are set in OberonLib.MemReqs if
* you don't import modules that clear these flags in their startup
* code (Usually, decent modules don't do things like that!).
*
* SEE ALSO
* Exec/AllocMem()
*
*****************************************************************************)
BEGIN
DynamicExtra := defaultDynamicExtra;
o.MemReqs := o.MemReqs + LONGSET{e.public,e.memClear};
UnderScore := '_';
req := e.OpenLibrary ("reqtools.library", 38);
CLOSE
IF req # NIL THEN e.CloseLibrary (req); req := NIL; END;
IF loc.base # NIL THEN IF DefaultCatalog # NIL THEN
loc.CloseCatalog (DefaultCatalog); DefaultCatalog := NIL;
END; END;
IF waitPointer # NIL THEN e.FreeVec (waitPointer); waitPointer := NIL; END;
END BlackMagic.